Adding a condition a Macro

[Lucson]

I have a working Macro where I want to add a condition to compare the 1st 3
digit of a cell to the 1st 3 digit of a header column, if matches, paste
under that column if not check next Header column. If the intersection has
nothing put "NOTHING".

Note: I am not a professional programmer. I learn (and still) to code VBA to
make my life easier, when an action is programmable.

 

[JLGWhiz]

Your scenario description is a little vague but here
are the basics. Assumes header in Row 1.

Dim lstCol As Long, c As Range
lstCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each c In Range("A1", Cells(1, lstCol))
If Left(ActiveCell.Value, 3) = Left(c.Value, 3) Then
"Paste something somewhere
Else
ActiveCell = "Nothing" 'not sure about this
End If
Next

This code is not intended to work. It is intended for
guidance only.

 

[JP]

Why not post what you have so far? It would be far easier to help you.


--JP

 

[Lucson]

Here are the codes

Public FinalRow As Variant
Public RightRow As Long
Public PasteRow As Long
Public Serial1 As String
Public Serial2 As String
Public i As Long
Public j As Integer
Sub Macro1()
'
' Macro1 Macro
'

' ID last row
FinalRow = Range("A65536").End(xlUp).Row


' Sort data by "Source_Customer_Code" and freeze column header
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

For i = 2 To FinalRow
j = i + 1

Do
RightRow = Range("IV" & i).End(xlToLeft).Column

Dim lstCol As Long, c As Range
lstCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each c In Range("A1", Cells(1, lstCol))
If Left(ActiveCell.Value, 3) = Left(c.Value, 3) Then

Else
ActiveCell = "NOTHING"
End If
Next


PasteRow = RightRow + 1

Serial1 = Cells(i, 1).Value 'Give Cust_Cd a value
Serial2 = Cells(j, 1).Value

If Serial1 = Serial2 Then ' test value against row below
Range("H" & j).Copy
Cells(i, PasteRow).PasteSpecial
Rows(j & ":" & j).Select
Selection.Delete
ElseIf Serial2 = "" Then GoTo Done ' this command stops loop

End If

Loop Until Serial1 <> Serial2 ' this allow loop to delete multiples of
three or more

Next i

Done:

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.EntireColumn.AutoFit
Selection.ColumnWidth = 25.57
Columns("A").Select
Columns("A").EntireColumn.AutoFit
Rows("2:4").Select
Selection.RowHeight = 27
Rows("2:4").EntireRow.AutoFit
Range("E1").FormulaR1C1 = "Account"
' Range("E1").AutoFill Destination:=Range("E1:" & PasteRow &
1), Type:=xlFillDefault

MsgBox "File transposed."