Hi everyone,
I have a question about the VBA code I wrote below.
First of all, a brief summary of what I try to achieve:
I have 2 excel sheets, sheet1 and sheet2. The sheet1 has the data in B:AW and the sheet2 has a data in the M:W. I wanted to create a VBA code that copies the data in B:I and M:O starting from 7th row from sheet1 to B:K of sheet2 starting from again 7th row by also keeping the formatting same. I also set the last row to be copied the row above the sheet includes "Comment sheet" in column B. So for instance, lets assume that B1200 has "Comment sheets" in the cell so the code takes the data in B7:I1199 and M7:O1199 from sheet 1 and copies to sheet2 B7:K1199.
As a next step, I also wanted to capture all the updates in copied columns of sheet1 in sheet2 automatically. The code, apparently, does the job and every time I press run, it captures the update. I will probably assign a button to let the users update sheet2 according to the updates sheet1.
But I have 2 problems:
1- When I add a new row in sheet1 and run the code, the new row in sheet2 is added for only columns B:K. However, as I said above, I have more data in M:W which is not depending on any data in sheet1. So when I add a new row in sheet1, I want this row to be added in sheet2 not only for B:K but also M:W (which means a new row for B:W).
2- When I add a new row in sheet1, run the code, delete the row in sheet1 and run the code, it does not move the last row up in sheet2, instead keeps the last row in sheet2 and duplicates this row above. Lets assume our last row is 1199 and B1199 is "AAA", so when I add a new row in sheet1, run the code, B1199 moves to B1200 as expected but when I delete the row in sheet1 and run the code, B1200 stays as "AAA" and B1199 becomes "AAA" too.
Unfortunately, I cannot share the file due to confidentiality but I hope the description above is clear enough. I am sharing the code below as well, which I hope will give a better idea.
I am quite new to VBA and my knowledge is very limited so I am also open to any suggestions that makes the code more readable and tidy.
Many thanks in advance.
I have a question about the VBA code I wrote below.
First of all, a brief summary of what I try to achieve:
I have 2 excel sheets, sheet1 and sheet2. The sheet1 has the data in B:AW and the sheet2 has a data in the M:W. I wanted to create a VBA code that copies the data in B:I and M:O starting from 7th row from sheet1 to B:K of sheet2 starting from again 7th row by also keeping the formatting same. I also set the last row to be copied the row above the sheet includes "Comment sheet" in column B. So for instance, lets assume that B1200 has "Comment sheets" in the cell so the code takes the data in B7:I1199 and M7:O1199 from sheet 1 and copies to sheet2 B7:K1199.
As a next step, I also wanted to capture all the updates in copied columns of sheet1 in sheet2 automatically. The code, apparently, does the job and every time I press run, it captures the update. I will probably assign a button to let the users update sheet2 according to the updates sheet1.
But I have 2 problems:
1- When I add a new row in sheet1 and run the code, the new row in sheet2 is added for only columns B:K. However, as I said above, I have more data in M:W which is not depending on any data in sheet1. So when I add a new row in sheet1, I want this row to be added in sheet2 not only for B:K but also M:W (which means a new row for B:W).
2- When I add a new row in sheet1, run the code, delete the row in sheet1 and run the code, it does not move the last row up in sheet2, instead keeps the last row in sheet2 and duplicates this row above. Lets assume our last row is 1199 and B1199 is "AAA", so when I add a new row in sheet1, run the code, B1199 moves to B1200 as expected but when I delete the row in sheet1 and run the code, B1200 stays as "AAA" and B1199 becomes "AAA" too.
Unfortunately, I cannot share the file due to confidentiality but I hope the description above is clear enough. I am sharing the code below as well, which I hope will give a better idea.
I am quite new to VBA and my knowledge is very limited so I am also open to any suggestions that makes the code more readable and tidy.
Many thanks in advance.
VBA Code:
Sub CopyPartialDataToSheet2()
'Declare variables
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
'Set worksheets
Set ws1 = ThisWorkbook.Sheets("sheet1")
Set ws2 = ThisWorkbook.Sheets("sheet2")
'Find last row in sheet1 and sheet2
lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
'Find last row to be copied in sheet1
Do While ws1.Cells(lastRow1, "C").Value <> "Comment Sheets"
lastRow1 = lastRow1 - 1
Loop
lastRow1 = lastRow1 - 5
'Print debug information
Debug.Print "lastRow1: " & lastRow1 & ", lastRow2: " & lastRow2
'Set ranges to be copied
Set rng1 = ws1.Range("C7:I" & lastRow1)
Set rng2 = ws1.Range("M7:O" & lastRow1)
'Copy ranges from sheet1 to sheet2
rng1.Copy ws2.Range("B7")
rng2.Copy ws2.Range("B7").Offset(0, rng1.Columns.Count)
'Adjust column widths in sheet2 to match those in sheet1
For i = 1 To rng1.Columns.Count
ws2.Columns(i).ColumnWidth = ws1.Columns(i).ColumnWidth
Next i
For i = 1 To rng2.Columns.Count
ws2.Columns(i + rng1.Columns.Count).ColumnWidth = ws1.Columns(i + rng1.Columns.Count).ColumnWidth
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Declare variables
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rngHeights As Range
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim i As Long
'Exit the sub if the change was not made in sheet1
If Target.Parent.Name <> "sheet1" Then Exit Sub
'Set worksheets
Set ws1 = ThisWorkbook.Sheets("sheet1")
Set ws2 = ThisWorkbook.Sheets("sheet2")
'Find last row in sheet1 and sheet2
lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
'Find last row to be copied in sheet1
Do While ws1.Cells(lastRow1, "B").Value <> "Comment Sheets"
lastRow1 = lastRow1 - 1
Loop
lastRow1 = lastRow1 - 5
'Print debug information
Debug.Print "lastRow1: " & lastRow1 & ", lastRow2: " & lastRow2
'Set ranges to be copied
Set rng1 = ws1.Range("B7:K" & lastRow1)
Set rng2 = ws1.Range("M7:O" & lastRow1)
Set rng3 = ws2.Range("M7:W" & lastRow1)
'Copy data and row heights from sheet1 to sheet2
rng1.Copy ws2.Range("B7")
rng2.Copy ws2.Range("B7").Offset(0, rng1.Columns.Count)
If lastRow1 > lastRow2 Then
ws2.Range("B" & lastRow2 + 1 & ":K" & lastRow1).Insert Shift:=xlDown
rng3.Copy ws2.Range("B" & lastRow2 + 1).Offset(0, rng1.Columns.Count + rng2.Columns.Count)
Set rngHeights = ws1.Range("B" & lastRow2 + 1 & ":B" & lastRow1)
For i = 1 To rngHeights.Rows.Count
ws2.Rows(lastRow2 + i).RowHeight = rngHeights.Rows(i).RowHeight
Next i
End If
End Sub
