PC Review


Reply
Thread Tools Rate Thread

Adding a condition a Macro

 
 
Lucson
Guest
Posts: n/a
 
      23rd Oct 2008
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 With Quote
 
 
 
 
JLGWhiz
Guest
Posts: n/a
 
      23rd Oct 2008
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

 
Reply With Quote
 
JP
Guest
Posts: n/a
 
      23rd Oct 2008
Why not post what you have so far? It would be far easier to help you.


--JP

On Oct 23, 11:52*am, Lucson <Luc...@discussions.microsoft.com> wrote:
> I have a working Macro where I want to add a condition to compare the 1st3
> 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 VBAto
> make my life easier, when an action is programmable.
> --
> Always Learning


 
Reply With Quote
 
Lucson
Guest
Posts: n/a
 
      23rd Oct 2008
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."



--
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 <Luc...@discussions.microsoft.com> 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 With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Adding a new condition Shhhh Microsoft Excel Discussion 2 6th Jun 2009 06:12 PM
Adding an IIF to a where condition? Frank Microsoft Access Macros 3 25th Aug 2008 09:34 PM
Adding a second formatting condition. bollard Microsoft Excel Worksheet Functions 2 21st Aug 2008 10:24 AM
Need Help Adding a 2nd Where Condition =?Utf-8?B?Um9iZXJ0IFQ=?= Microsoft Access Reports 10 29th Sep 2006 12:48 PM
Adding the 2nd and 3rd condition =?Utf-8?B?Sk9N?= Microsoft Access 0 27th Feb 2006 09:51 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 12:34 AM.