Consulting

Results 1 to 3 of 3

Thread: Solved: loop

  1. #1
    VBAX Tutor
    Joined
    Sep 2007
    Posts
    265
    Location

    Solved: loop

    Dear Expert,

    Following my previous post with tittle "Split By text", herewith
    I want to create an automatic number or value only if in column B type of value is Ritz . then save the last number/value in lastrow to range H1. So, every time we run a macro then range H1 will be a lastnumber value. Example: if yesterday value in range H1 is 6, than today the value will be started from 7 to ... defending on how many row in column B that containing type a word of Ritz.

    I'm assuming, we need to sort all data in range A5:P13 and insert a column in column C then run a macro to generating a number.
    However, I need the number is not a number but a text value. for example the number is 1 then it will be replaced into '00001.

    Another process/step is we split the all data into sheet 3 and sheet 4 based on criteria.

    Please advice me on how the vba code to do this.
    Thank you so much for your assistance.
    Rgds, Harto

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    Private Sub Splitme()
    Dim LastRow As Long
    Dim NextRow1 As Long
    Dim NextRow2 As Long
    Dim i As Long
    Dim cnt As Long

    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "System is starting genereate Ritz Carlton Dining Card number, Please wait a moment...."
    End With

    Sheets(2).Visible = xlSheetVisible
    Sheets(3).Visible = xlSheetVisible

    With Worksheets("Main")

    '.Unprotect Password:="?????"

    .Columns(3).Insert
    .Range("C4").Value = "DINING CARD#"
    .Rows(4).Copy Sheets(2).Range("A1")
    .Rows(4).Copy Sheets(3).Range("A1")
    NextRow1 = 2
    NextRow2 = 2

    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    For i = 5 To LastRow

    If .Cells(i, "B").Value = "Ritz" Then

    cnt = cnt + 1
    .Cells(i, "C").Value = "'" & Format(cnt, "00000")

    NextRow1 = NextRow1 + 1
    .Rows(i).Copy Sheets(2).Cells(NextRow1, "A")

    Else

    NextRow2 = NextRow2 + 1
    .Rows(i).Copy Sheets(3).Cells(NextRow2, "A")
    End If
    Next i
    End With

    With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = ""
    End With

    Sheets(1).Activate

    MsgBox "Data has been transferred and " & vbCrLf & _
    "the result has been copied into : " & vbCr & vbCrLf & _
    "sheet : " & Sheets(2).Name & vbCrLf & _
    "sheet : " & Sheets(3).Name, vbInformation, "Successed!"

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Tutor
    Joined
    Sep 2007
    Posts
    265
    Location
    Bob,

    As usual, the code work great.
    Even, just a bit modified. this case is close anyway.
    As always. Thank you so much.
    have a great weekend!

    Best, harto

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •