Im using the below code to copy barcode data from the B column of the user selected range on one sheet ('EquipmentData') to the G column of the next available row on another sheet ('ReturnData'). I am looking for help to take this code one step further. In some cases there will be blanks within the selected range that is being copied over. In these instances I would like it to enter 'none' in those blank cells being copied over to the 'ReturnData' sheet (so there should be no cells without data on 'ReturnData'). When this occurs it should also copy the data in the adjacent C column in 'EquipmentData' (on the blank cell rows) and enter it into the F column of the corresponding rows on 'ReturnData'.
The code also enters data into the columns D, E, H and I at the sometime which should remain the same.
So basically the F column on 'ReturnData' has a VLOOKUP formula to match the data being copied into G to the corresponding C column in 'EquipmentData'. However when there is no barcode (when B column on EuqipmentData is blank) then obviously the VLOOKUP doesn't work, so I need VBA to copy over that data instead.
Private Sub AddRecords_Click()
If Not cbUnit.ListIndex > -1 Then
Msg = "The Unit ''" & cbUnit & "'' is not in the list. Do you wish to add it as a new unit?"
Ans = MsgBox(Msg, vbQuestion + vbYesNo)
Select Case Ans
Case vbYes
With Sheets("UnitList")
If .Range("A1").Value = "" Then
.Range("A1").Value = Me.cbUnit.Value
Else
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Me.cbUnit.Value
End If
End With
Unload Me
Sheets("ReturnData").Activate
Case vbNo
cbUnit.Value = ""
End Select
Else
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim FirstRowSelect As Long
Dim LastRowSelect As Long
Dim LastRowPaste As Long
FirstRowSelect = Selection.Rows(1).Row
LastRowSelect = Selection.Rows.Count + FirstRowSelect - 1
NumberOfSelRows = LastRowSelect - FirstRowSelect
Set EquipmentDataSheet = Worksheets("EquipmentData")
Set ReturnDataSheet = Worksheets("ReturnData")
LastRowPaste = Worksheets("ReturnData").Cells(Rows.Count, "G").End(xlUp).Offset(1).Row
PasteRange = LastRowPaste + NumberOfSelRows
With Worksheets("ReturnData")
.Range("D" & LastRowPaste, .Range("D" & PasteRange)) = Date
.Range("E" & LastRowPaste, .Range("E" & PasteRange)) = "Receive"
.Range("H" & LastRowPaste, .Range("H" & PasteRange)) = cbUnit.Value
.Range("I" & LastRowPaste, .Range("I" & PasteRange)) = tbPurchaseOrder.Value
End With
With Worksheets("EquipmentData")
.Range("B" & FirstRowSelect, .Range("B" & LastRowSelect)).Copy
Worksheets("ReturnData").Range("G" & LastRowPaste).PasteSpecial xlPasteValues
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Unload Me
Sheets("ReturnData").Activate
End If
End Sub
Thanks,
James
Bookmarks