I am new to VBA and I will need a help.
I have a worksheet named "Jobs" with raw data table and I want to copy paste certain cells to another worksheet named "Schedule" provided that the source and destination date matches and I use the below. But, I have 3 jobs for the same date and it copy only one. Any help will be appreciated.
Sub CopyBasedonSheet1()
Dim i As Long
Dim j As Long
Worksheets("Schedule").Range("B1:AJ92").ClearContents
Sheet1LastRow = Worksheets("Jobs").Range("G" & Rows.Count).End(xlUp).Row 'G is the Date Column'
Sheet2LastRow = Worksheets("Schedule").Range("A" & Rows.Count).End(xlUp).Row 'A is the Date column'
For j = 1 To Sheet1LastRow
For i = 1 To Sheet2LastRow
If Worksheets("Jobs").Cells(j, 7).Value = Worksheets("Schedule").Cells(i, 1).Value And Worksheets("Jobs").Cells(j, 1).Value = "P" Then
Worksheets("Schedule").Cells(i, 2).Value = Worksheets("Jobs").Cells(j, 3).Value
Worksheets("Schedule").Cells(i, 3).Value = Worksheets("Jobs").Cells(j, 9).Value
Worksheets("Schedule").Cells(i, 4).Value = Worksheets("Jobs").Cells(j, 14).Value
End If
Next i
Next j
End Sub
Related
I just can't seem to get this for loop running correctly. I know that I missing something basic, but I just can't figure it.
I have 2 tables.
Table 1 : (Table starts at row 7, and columns i to q are hidden)
Table 2 :
My goal is to pull new rows from Table1 to Table2.
My code rolls through Table 1, identifies the rows with an 'R' value, and fills them.
Then I want to pull data from those same rows to Table2
The code that identifies and fills the 'R' value:
Dim iRow As Long
With Sheet12
iRow = Application.Count(.ListObjects("Table1").ListColumns("KEY").DataBodyRange)
End With
'find last row with a date
Dim jRow As Long
With Sheet12
jRow = Application.Count(.ListObjects("Table1").ListColumns("Date").DataBodyRange)
End With
'take the value from iRow and col 1, add 1, place in iRow+1,1
Dim q As Long
For q = iRow + 7 To jRow + 6
Sheet12.Cells(q, 18) = 1 + Sheet12.Cells(q - 1, 18)
Next q
Then this bit I'm having trouble with. My thought was try to run a double loop, where I loop through to fill each column and then each row.
Dim a As Long
Dim b As Long
Dim c As Long
c = jRow - iRow
For b = 11 To c + 11
For a = iRow + 7 To jRow + 6
ws15.Cells(b, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(b, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(b, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(b, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(b, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(b, 6).Value = 1001
ws15.Cells(b, 7).Value = "FILL IN"
Next a
Next b
Now the above code only copies the last row from Table1 into Table2 four times.
I know I'm close, and I'm sure I'm just tired, but I can't get it right. I appreciate everyone's time.
The double loop is causing the problem. The inside loop fills in the same row 4 times. This explains why every row has the same data.
You want to iterate the rows together so you just need 1 loop. The b variable is not needed.
Try this code:
Dim a As Long
Dim c As Long
c = jRow - iRow + 7 'start row on new sheet
For a = iRow + 7 To jRow + 6 'source data rows
ws15.Cells(c, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(c, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(c, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(c, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(c, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(c, 6).Value = 1001
ws15.Cells(c, 7).Value = "FILL IN"
c = c + 1 'next row on new sheet
Next a
My VBA script errors when I try to insert data from Sheet1 into Sheet2. Script code delivers only "Case 2-3" ROW numbers, first "Case" does not input into Sheet 2. Wondering what else should be included in VBA script to finalize processes?
My VBA Script:
Sub CopyFromSheet1()
Dim i As Long
For i = 1 To Sheet1.Cells(Sheet1.Rows.Count, 6).End(xlUp).Row ' Last Cell of Column F
Select Case CStr(Sheet1.Cells(i, 3).Value) ' Looks at the Value in Column C
Case "Due From"
Sheet2.Cells(22, 3).Value = Sheet1.Cells(i, 6).Value
Case "TOTAL1"
Sheet2.Cells(23, 3).Value = Sheet1.Cells(i, 6).Value
Case "TOTAL2"
Sheet2.Cells(24, 3).Value = Sheet1.Cells(i, 6).Value
End Select
Next i
End Sub
What about this: Do you everything your doing, but just for Column C. And then Do it all again for column D?
Sub CopyFromSheet1()
Dim i As Long
Dim col as Long
for col = 3 to 4
For i = 1 To Sheet1.Cells(Sheet1.Rows.Count, 6).End(xlUp).Row ' Last Cell of Column F
Select Case CStr(Sheet1.Cells(i, col).Value)
Case "Due From"
Sheet2.Cells(22, 3).Value = Sheet1.Cells(i, 6).Value
Case "TOTAL1"
Sheet2.Cells(23, 3).Value = Sheet1.Cells(i, 6).Value
Case "TOTAL2"
Sheet2.Cells(24, 3).Value = Sheet1.Cells(i, 6).Value
End Select
Next i
next col
End Sub
I am trying to grab data from three columns in my workbook AK,AL and AM respectively. After getting the data I am doing 3 different comparisons which are stated in the code below.
Firstly, I am comparing the date in Column AL and Column AM. I am checking if Column AL is of year 2018 and Column AM is not of year 2018. If its true then It will insert text in Column L called "Routine". This is done cell by cell using a for loop as seen in the code.
Next, there is a check if Column AM is of year 2018 and Column AK is color coded to Yellow color. If it is true then text will be inserted in Column L called "New".
Lastly, there is a check if Column AM is of year 2018 and Column AK is not colored in Yellow. If it is true then text will be inserted in Column 'L' called "Major"
Else, The cell will be left blank without any data inserted.
PROBLEM: The code runs fine and there are no issues or errors. But I am not able to get the output I want. The code does not insert any text in the Column L
Dim j As Long
Dim lastrow As Long
Dim ws1 As Worksheet
Dim wbk As Workbook
Dim wb As Worksheet
Dim date1 As Date, date2 As Date
Set wbk = Application.Workbooks("MaxiTrak RV Service Report - Blank.xlsm")
Set ws1 = wbk.Worksheets("ML_PSV_SERVICE")
lastrow = ws1.range("AL" & Rows.Count).End(xlUp).Row
For j = 2 To lastrow
date1 = ws1.Cells(j, 38).Value
date2 = ws1.Cells(j, 39).Value
If Year(date1) = Year(Date) - 1 And Year(date2) <> Year(Date) - 1 Then
Cells(j, 12).Value = "Routine"
If Year(date2) = Year(Date) - 1 And Cells(j, 37).Interior.ColorIndex = 6 Then
Cells(j, 12).Value = "New"
If Year(date2) = Year(Date) - 1 And Cells(j, 37).Interior.ColorIndex <> 6 Then
Cells(j, 12).Value = "Major"
Else
Cells(j, 12).Value = ""
End If
End If
End If
Next j
Sample Output expected
Try code below, it's pretty simple and self-explanatory:
Sub Compare()
Dim lastRow As Long, i As Long
lastRow = Range("AK" & Rows.Count).End(xlUp).Row
For i = 1 To lastRow
If Year(Range("AM" & i)) <> 2018 Then
If Year(Range("AL" & i)) = 2018 Then Range("L" & i) = "Routine"
' column AM has year equal to 2018
ElseIf Range("AK" & i).Interior.ColorIndex = 6 Then
Range("L" & i) = "New"
Else
Range("L" & i) = "Major"
End If
Next
End Sub
In the following code that you supplied you have:
If Year(date2) = Year(Date) - 1 And Cells(j, 37).Interior.ColorIndex = 6 Then
Cells(j, 12).Value = "New"
If Year(date2) = Year(Date) - 1 And Cells(j, 37).Interior.ColorIndex <> 6 Then
Cells(j, 12).Value = "Major"
Else
Cells(j, 12).Value = ""
End If
End If
Where you get into the first if statement because cells(j,37).interior.colorindex = 6, but then, you do a check where cells(j,37).interior.colorindex <> 6.
The conflict here is that it will always set cells(j,12).value = "". Either your first cell reference is off or your second reference is off. Another possibility is that you need to change one of the colorindex values.
From your description, I believe you have too many if statements. You also have an if statement nested inside another if statement.
Dim j, lastrow As Long
Dim ws1, wb As Worksheet
Dim wbk As Workbook
Dim dateAL, dateAM As Date
Dim colorID As Variant
Set wbk = Application.Workbooks("MaxiTrak RV Service Report - Blank.xlsm")
Set ws1 = wbk.Worksheets("ML_PSV_SERVICE")
lastrow = ws1.Range("AL" & Rows.Count).End(xlUp).Row
currentyear = Year(Date)
For j = 2 To lastrow
dateAL = Year(ws1.Cells(j, 38).Value) ' column AL
dateAM = Year(ws1.Cells(j, 39).Value) ' column AM
colorID = ws1.Cells(j, 37).Interior.ColorIndex
If dateAL = currentyear - 1 And dateAM <> currentyear - 1 Then
Cells(j, 12).Value = "Routine"
Else
If dateAM = currentyear - 1 And colorID = 6 Then
Cells(j, 12).Value = "New"
Else
Cells(j, 12).Value = "Major"
End If
End If
Next j
Try the above code, but please review the code FIRST.
I have an existing VBA code that copies rows if an identifier column is marked with 'X'. Now I want it to be based off a date range entered by the user. Can somebody please help me convert the existing code to my required one? Thanks!
Sub CopyRow()
Application.ScreenUpdating = False
Dim x As Long, MaxRowList As Long, MaxRowList2 As Long, S As String, wsSource As Worksheet, wsTarget As Worksheet, S2 As Long
Set wsSource = ThisWorkbook.Worksheets("Sheet 1 - RAW")
Set wsTarget = ThisWorkbook.Worksheets("Staging")
iCol = 1
MaxRowList = wsSource.Cells(Rows.Count, iCol).End(xlUp).Row
MaxRowList2 = wsTarget.Cells(Rows.Count, iCol).End(xlUp).Row
S2 = 8
wsTarget.Range("A8:H22").ClearContents
For x = 4 To MaxRowList
If InStr(1, wsSource.Cells(x, 19), "X") Then
wsTarget.Cells(S2, 1).Value = wsSource.Cells(x, 1).Value
wsTarget.Cells(S2, 4).Value = wsSource.Cells(x, 2).Value
wsTarget.Cells(S2, 5).Value = wsSource.Cells(x, 10).Value
wsTarget.Cells(S2, 6).Value = wsSource.Cells(x, 16).Value
wsTarget.Cells(S2, 7).Value = wsSource.Cells(x, 18).Value
wsTarget.Cells(S2, 8).Value = wsSource.Cells(x, 17).Value
S2 = S2 + 1
End If
Next
Application.ScreenUpdating = True
End Sub
You need to modify your if Statement.
If InStr(1, wsSource.Cells(x, 19), "X") Then
Will become
If wsSource.Cells(x, ColumnThatContainsTheDate).value > OlderDate and wsSource.Cells(x, 19).value < NewerDate Then
Now, your problem will become how do you want the user to select the dates? A form that he could dynamically select (using a calendar), just a plain input box or based on a value of a cell? Do you want everything that is older or newer to this date or do you want between two dates? Just adjust the statement to whatever suits your needs.
I have a set of data in this format:-
Note: It starts from Jan-17 to Dec-17. However, for this exercise I limit it to 3 months (Jan to Mar).
I wish to convert the data into this format:-
How can i achieve it using Excel?
Thanks in advance.
How about something like below, using a double For Loop to loop through rows and then columns and transfer data to Sheet2 in the desired format (this won't add the headers to Sheet2, but it will give you a some guidance as to how to go about it):
Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 2 To LastRow 'loop through rows
For col = 6 To 14 Step 4 'loop through columns
'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
ws.Range("A" & i & ":D" & i).Copy ws2.Range("A" & FreeRow) 'copy the first 4 columns into the free row
ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
Next col
Next i
End Sub
UPDATE:
I've added a couple of lines to the code to attempt to optimize the speed of it, also removed the Copy & Paste and altered it to pass the values without copying anything, please have a look below:
Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'optimize code:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
For i = 2 To LastRow 'loop through rows
For col = 6 To 14 Step 4 'loop through columns
'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
ws2.Cells(FreeRow, 1).Value = ws.Cells(i, 1).Value
ws2.Cells(FreeRow, 2).Value = ws.Cells(i, 2).Value
ws2.Cells(FreeRow, 3).Value = ws.Cells(i, 3).Value
ws2.Cells(FreeRow, 4).Value = ws.Cells(i, 4).Value
ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
Next col
Next i
'return to normal Excel status after macro has finished
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub