Re: Need help with VBA coding
The data in your actual files has a completely different setup from the sample you posted so we will have to start all over again one step at a time. You want to copy specific columns from the invoice list purchase 2018 (USD & EUR) to the material development purchase sheet. Which columns from the USD and EUR sheets in the invoice list purchase 2018 do you want to copy to the material development purchase sheet? What do you mean by: Please be very detailed in your description, referring to specific cell, rows, columns and sheets. Let's stop there for now and try to get this part done.
I was able to use the respective code by declaring it. but got stuck with the date.
I checked the format it seems to be dd-mm-jjjj which I modify and still got error message that I don't have the right format entered.
Sub CopyCols()
Application.ScreenUpdating = False
Dim srcWB As Workbook
Set srcWB = ThisWorkbook
Dim desWS As Worksheet
Set desWS = Workbooks("CombinedData.xlsx").Sheets("Sheet1")
desWS.UsedRange.ClearContents
Dim beginDate As String
Dim endDate As String
Dim lastRow As Long
Dim bottomA As Long
Dim ws As Worksheet
desWS.Range("A1:H1") = Array("Course Type", "Invoice No.", "Lecturer", "Description", "Net Amount", "Invoice Date", "Exchange", "Classification")
For Each ws In srcWB.Sheets(Array("Purchase USD", "Purchase EUR"))
If ws.Name = "Purchase USD" Then
bottomA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Intersect(ws.Rows("2:" & bottomA), ws.Range("A:A,D:E,G:G,K:L,N:N,S:S")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
ElseIf ws.Name = "Purchase EUR" Then
bottomA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Intersect(ws.Rows("2:" & bottomA), ws.Range("A:A,D:F,J:K,M:M,S:S")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next ws
Dim response as integer
response = InputBox("Please enter the search criteria for the course type material.")
If WorksheetFunction.CountIf(desWS.Range("A:A"), response) = 0 Then
MsgBox ("Filter criteria not found in Column A. Please try again.")
desWS.UsedRange.ClearContents
Exit Sub
End If
ReTry1:
beginDate = InputBox("Please enter the start date in format mm/dd/yyyy", "Beginning date", Format(Now(), "mm/dd/yyyy"))
If beginDate = "" Then
MsgBox ("You have not entered a date.")
desWS.UsedRange.ClearContents
Exit Sub
End If
If Format(beginDate, "mm/dd/yyyy") <> beginDate Then
MsgBox "Wrong date format. Please enter in format mm/dd/yyyy.": GoTo ReTry1
End If
ReTry2:
endDate = InputBox("Please enter the end date in format mm/dd/yyyy", "End date", Format(Now(), "mm/dd/yyyy"))
If endDate = "" Then
MsgBox ("You have not entered a date.")
desWS.UsedRange.ClearContents
Exit Sub
End If
If Format(endDate, "mm/dd/yyyy") <> endDate Then
MsgBox "Wrong date format. Please enter in format mm/dd/yyyy.": GoTo ReTry2
End If
desWS.Activate
desWS.Columns.AutoFit
lastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
desWS.Range("A1:H" & lastRow).AutoFilter Field:=1, Criteria1:="<>" & response
If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
desWS.Range("A1:H" & lastRow).AutoFilter Field:=6, Criteria1:="<" & CDate(beginDate)
If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
desWS.Range("A1:H" & lastRow).AutoFilter Field:=6, Criteria1:=">" & CDate(endDate)
If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
