I'm trying to modify existing code below to combine data from two cells on worksheet ARMELE cells "B" & "C" to worksheet Mat.Req.Form "H"
Please see code in red where the problem is: Thanks in advance!
Please see code in red where the problem is: Thanks in advance!
Code:
Option ExplicitOption Base 1
Const IsChecked As String = "a"
Sub TransferData()
Dim ARMELE As Worksheet, REQFORM As Worksheet
Dim CheckList As Range, CheckBox As Range
Dim InvCount As Long, ReqRow As Long, UnitDivisor As Long, d As Long
Dim UnitIssue As String, DestM As Variant, DestP As Variant
Const strPassword As String = "Password"
ActiveSheet.Unprotect Password:=strPassword
On Error Resume Next
DestM = Array(8) 'material columns
DestP = Array(12) 'price columns
Set ARMELE = Worksheets("armele") 'source worksheet
Set REQFORM = Worksheets("Mat. Req. Form") 'destination worksheet
Set CheckList = ARMELE.Range("G:G").SpecialCells(xlConstants) 'cells with checkmarks
If CheckList Is Nothing Then
MsgBox "No items were checked to copy!"
Exit Sub
End If
'next order-form row to fill, based on column H (Description)
ReqRow = REQFORM.Cells(Rows.Count, "H").End(xlUp).Row + 1
If ReqRow > 33 Then
MsgBox "Mat. Req. Form is Full! ( Press OK to delete remaining check marks? )"
' DeleteColumn Macro
'
'
Columns("G:G").Select
Selection.ClearContents
Sheets("Mat. Req. Form").Select
Range("S11").Select
Exit Sub
End If
d = 1 'destination array item
For Each CheckBox In CheckList
If CheckBox = IsChecked Then
'material
[COLOR=#ff0000] REQFORM.Cells(ReqRow, DestM(d)).Value = ARMELE.Cells(CheckBox.Row, "C").Value[/COLOR]
'price
Select Case UCase(ARMELE.Cells(CheckBox.Row, "D").Value)
Case Is = "C", "H", "J", "HU": UnitDivisor = 100
Case Is = "M", "T": UnitDivisor = 1000
Case Is = "E", "F", "R", "B", "P", "RL", "BX", "PK", "CD", "FT", "KG", "PC", "JR": UnitDivisor = 1
End Select
REQFORM.Cells(ReqRow, DestP(d)).Value = ARMELE.Cells(CheckBox.Row, "F").Value / UnitDivisor
CheckBox = "" 'clear the check mark
If ReqRow = 33 Then 'increment to next req form row/column
If d = 1 Then
MsgBox "Mat. Req. Form is full! ( Press OK to delete remaining check marks? )"
' DeleteColumn Macro
'
'
Columns("G:G").Select
Selection.ClearContents
Sheets("Mat. Req. Form").Select
Range("S11").Select
Exit Sub
Else
ReqRow = 14
d = 1
End If
Else
ReqRow = ReqRow + 1
End If
End If
Next CheckBox
ActiveSheet.Protect Password:=strPassword
End Sub