PDA

View Full Version : Solved: loop



slamet Harto
09-17-2008, 07:39 PM
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

Bob Phillips
09-18-2008, 12:18 AM
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

slamet Harto
09-18-2008, 07:03 PM
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