I have a working macro, that basically cuts row from base sheet, if values in rows fist cell (column A) matches a value in target sheets cell = B1, and to paste it in target sheets first empty row (checks cells in column A). But as the functionality of my Excel needs to be slightly changed, I need to make some adjustments, but all my attempts have failed so far.
Here is the working code:
Sub RowCopy()
Application.ScreenUpdating = False
Set shtarget = Sheets("TargetSheet")
Set shBase = Sheets("BaseSheet")
For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
If shBase.Cells(i, 1).Value = shtarget.Cells(1, 2).Value Then
shBase.Rows(i).EntireRow.Cut
shtarget.Rows(shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Insert Shift:=xlDown
shBase.Rows(i).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Set shtarget = Nothing
Set shBase = Nothing
Application.ScreenUpdating = True
End Sub
And here are issues, which I'm dealing with:
Issue nr.1:
The code does not work if cell B1 contains mixed text and number and (dash/comma/space), for example: "white - 32". I've tried to use Variant, but it did not work correctly each time and made data sorting quite slower especially with large data amount.
Here I've tried to compare two cells with StrComp, the code itself didn't show any errors, but also did not do the thing that it should do - which is - copying data to target sheet:
Sub RowCopy()
Application.ScreenUpdating = False
Set shtarget = Sheets("TargetSheet")
Set shBase = Sheets("BaseSheet")
For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
If StrComp(shBase.Cells(i, 1).Value, shtarget.Cells(1, 2).Value) = 0 Then
shBase.Rows(i).EntireRow.Cut
shtarget.Rows(shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Insert Shift:=xlDown
shBase.Rows(i).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Set shtarget = Nothing
Set shBase = Nothing
Application.ScreenUpdating = True
End Sub
What am I missing?
Is there more efficient way to compare mixedtype data in cells?
Issue nr.2:
With the existing code, copying entire row interferes with data in target sheets right part of the page, as it is shifting rows down. But, it is necessary to cut/copy certain part of row (for example: from A2:J2) from base sheet and paste only data in target sheets region from A to J, while not messing up other part of the target sheet. It should act more like stepping 1 row down, not inserting and shifting rows, which is happening with the existing code.
I've tried substituting "EntireRow" with Range(A2:J2), but it only left me with necessary data missing and wrong data copying to my target sheet.
How to define specific Range of a row in code below to paste only data in target sheet, while not inserting new rows (and not messing up other data which is out of the target sheets A:J range)?
Sub RowCopy()
Application.ScreenUpdating = False
Set shtarget = Sheets("TargetSheet")
Set shBase = Sheets("BaseSheet")
For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
If shBase.Cells(i, 1).Value = shtarget.Cells(1, 2).Value Then
shBase.Rows(i).EntireRow.Cut
shtarget.Rows(shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Insert Shift:=xlDown
shBase.Rows(i).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Set shtarget = Nothing
Set shBase = Nothing
Application.ScreenUpdating = True
End Sub
I don't see any issues with searching for (eg) "white - 32"...
Sub RowCopy()
Dim shtarget As Worksheet, shBase As Worksheet
Dim vGet, cDest As Range, i As Long
Application.ScreenUpdating = False
Set shtarget = Sheets("TargetSheet")
Set shBase = Sheets("BaseSheet")
'get initial paste position
Set cDest = shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Offset(1, 0)
'value being searched for
vGet = shtarget.Cells(1, 2).Value
For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
If shBase.Cells(i, 1).Value = vGet Then
shBase.Cells(i, 1).Resize(1, 10).Copy cDest 'copy 10 columns
shBase.Rows(i).EntireRow.Delete
Set cDest = cDest.Offset(1, 0)
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.