Posts by davesexcel

davesexcel · Wednesday, 3:48 pm

If there is an error, you wouldn't know because of the error trap, stop the error trap to see if there is an error.(line 5) comment out

davesexcel · Tuesday, 6:18 pm

Code

"C:\Users\Sams\OneDrive - CompanyABC\Sam S\Work Links\4Contractor Invoices & WO\LHW Consulting (Lance)\LHW Consulting INV" & range("B5").value & " for WO D94786.pdf"

davesexcel · Mar 29th 2020

To mark the thread solved, click on "Settings" in your response and then click "Mark as Resolved".

davesexcel · Mar 29th 2020

Please mark as solved

davesexcel · Mar 24th 2020

Quote from alhagag

Me.Controls("xx" & c).Caption

From what I see there is no control xx1, xx2, xx3.

Maybe at one time there were labels named xx1,xx2,xx3.... from where you originally got the code.

davesexcel · Mar 24th 2020

Okay, I see what you are trying to do.

You are making sure the textboxes are not empty.

Code

For c = 1 To ContColmn
Ad = Cells(1, c).Address(0, 0)
If Len(Trim(Me.Controls(Ad).Value)) = 0 Then
MsgBox "address: " & Cells(1, c).Value & " empty", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "empty cells"
Me.Controls(Ad).SetFocus
Exit Sub
End If
Next

davesexcel · Mar 24th 2020

Me.Controls("xx" & c).Caption

Is nothing, the code can't find it so the object is not found.

What is the purpose of these lines of code?

Code

For c = 1 To ContColmn
Ad = Cells(1, c).Address(0, 0)
If Len(Trim(Me.Controls(Ad).Value)) = 0 Then
MsgBox "address: " & Me.Controls("xx" & c).Caption & " empty", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "empty cells"
Me.Controls(Ad).SetFocus
Exit Sub
End If
Next

davesexcel · Mar 24th 2020

You have the error wrong

Quote from alhagag

Me.Controls("xx" & c).Caption

Where is this control?

davesexcel · Mar 15th 2020

Do both sheets before you close the workbook

Code

Set wb = Workbooks.Open(fPath & fName)
With wb.Sheets(1)
If Application.CountA(.Rows(2)) > 0 Then
.UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
End If
End With
With wb.Sheets(4)
If Application.CountA(.Rows(2)) > 0 Then
.UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
End If
End With
wb.Close False

Display More

davesexcel · Mar 4th 2020

Change the folder name in the code

davesexcel · Mar 3rd 2020

I don't understand the query.

davesexcel · Mar 2nd 2020

I guess if you just wanted to save a bunch of blank workbooks.

Code

Sub CreatWB()
Dim rng As Range
Dim c As Range, sh As Worksheet
Dim wb As Workbook, nWb As Workbook
Dim dr As String
dr = "C:\Users\dmorrison\Desktop\Test2\"
Set wb = ThisWorkbook
Set sh = wb.Sheets(1)
Set nWb = Workbooks.Add
With sh
Set rng = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For Each c In rng.Cells
nWb.SaveAs (dr & c & ".xlsx"), 51
Next c
End With
End Sub

Display More

davesexcel · Mar 2nd 2020

A listbox could be better

davesexcel · Mar 2nd 2020

There may be a better option, what would you be doing with this information?

davesexcel · Mar 2nd 2020

You will have to supply more detail

davesexcel · Mar 1st 2020

Some confusion.

1-The code is for a word doc?

2-aa(x) is not Chinese

3- are you trying to replace what is in column A with what is in column B?

4- it looks like excel can count Chinese, but not lookup Chinese.

davesexcel · Feb 29th 2020

I assume you actually want a date value in the cell.

Possibly replacing the ":" with "-" first before would work

Code

Dim FirstBlankCell As Range
Set FirstBlankCell = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
With FirstBlankCell
nd = Replace(Me.txtcurrdate, ":", "-")
.Value = nd
.NumberFormat = "dd:mmm:yy"
End With

davesexcel · Feb 21st 2020

Loop through the columns

Code

Private Sub TextBox1_Change()
Dim c As Range
ListBox1.Clear
ListBox1.RowSource = ""
For Each c In Range("A2:A100")
B = InStr(c, TextBox1.Value)
If B > 0 Then
With Me.ListBox1
.ColumnCount = 4
.ColumnWidths = "60;60;120;90"
.AddItem
.List(i, 0) = c
.List(i, 1) = c.Offset(, 1)
.List(i, 2) = c.Offset(, 2)
.List(i, 3) = c.Offset(, 3)
i = i + 1
End With
End If
Next c
End Sub

Display More

davesexcel · Feb 17th 2020

Assuming you need to use the find, instead of using rangeAreas

Code

Sub AlphaSORT()
Dim wdCnt As Long
Dim NxtC As Long
Dim rng As Range
Dim FndWrd As String
Dim c As Range, NewC As Range, Nxt As Long
Dim sh As Worksheet
Set sh = Sheets("Backup")
With sh
FndWrd = "Offer ID"
Set rng = .Range("A:A")
wdCnt = Application.WorksheetFunction.CountIf(rng, FndWrd)
Nxt = 1
If Not wdCnt = 0 Then
Do
Set c = rng.Find(what:=FndWrd, After:=.Range("A" & Nxt))
NxtC = NxtC + 1
If Not c Is Nothing Then
Set NewC = Range(c.Resize(, 20), c.Resize(, 20).End(xlDown))
With ActiveSheet
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=NewC.Columns(14), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange NewC
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End If
Nxt = c.Row + 1
Loop While Not NxtC >= wdCnt
End If
End With
End Sub

Display More

davesexcel · Feb 17th 2020

Posts by davesexcel

Stuck on infrequent errors in code

New to Macros - I would like to understand how to save a file with vixed values in the name as well as values from cells

problem posting data from userform to worksheet

problem posting data from userform to worksheet

problem posting data from userform to worksheet

problem posting data from userform to worksheet

problem posting data from userform to worksheet

problem posting data from userform to worksheet

Copy specific worksheets in excel workbooks in a folder into master worksheet

VBA to Put Workbook Names

VBA to Put Workbook Names

VBA to Put Workbook Names

search by combobox linked spinbutton

search by combobox linked spinbutton

VBA to Put Workbook Names

Chinese word replacer

Transferring date from userform to spreadsheet

show data in listbox from worksheet

VBA to Find Occurence of Word, Then Custom Sort LOOP

Paste method of worksheet class failed