Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding a condition a Macro
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. -- Always Learning |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding a condition a Macro
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. "Lucson" wrote: 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. -- Always Learning |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding a condition a Macro
Why not post what you have so far? It would be far easier to help you.
--JP On Oct 23, 11:52*am, Lucson wrote: 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. -- Always Learning |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding a condition a Macro
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:D").Select Columns("A:D").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." -- Always Learning "JP" wrote: Why not post what you have so far? It would be far easier to help you. --JP On Oct 23, 11:52 am, Lucson wrote: 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. -- Always Learning |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
adding up sums only if condition is met | Excel Worksheet Functions | |||
Adding up Cells Given a Condition | Excel Worksheet Functions | |||
Adding a second formatting condition. | Excel Worksheet Functions | |||
If formula---adding another condition | Excel Discussion (Misc queries) | |||
adding part of a function on condition. | Excel Worksheet Functions |