Need Macro to create a Format

[vishwakarma]

Hello Guys,

Need a small help in creating a macro which will segregate the data in a summarized format. Please refer the attach excel file for clear picture. Many thanks for the help.

Please Note: List can vary in numbers.


Many Thanks,
Manoj Kumar

[Bob Phillips]

Sub ProcessData()
Dim testValue As Long
Dim bandText As String
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns("A").Insert
testValue = 45
bandText = "45+"
For i = lastrow - 1 To 1 Step -1

If Not .Cells(i, "C").Value >= testValue Then

.Cells(i + 1, "A").Resize(, 3).Insert Shift:=xlDown
.Cells(i + 1, "A").Value = bandText
.Cells(i + 1, "A").Resize(, 3).Interior.ColorIndex = 15
If testValue = 45 Then

testValue = 40
bandText = "40"
Else

testValue = 30
bandText = "30-35"
End If
End If
Next i

.Columns("C").Copy
.Columns("A").PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False
End Sub

[vishwakarma]

Thank you! xld....it's just perfect.. Thanks again

[vishwakarma]

Just one more thing; it;s not categorizing the lowest category, i.e. not giving the header "30-35"...

Thanks,

[Bob Phillips]

This should fix it

Sub ProcessData()
Dim testValue As Long
Dim bandText As String
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns("A").Insert
testValue = 45
bandText = "45+"
For i = lastrow - 1 To 1 Step -1

If Not .Cells(i, "C").Value >= testValue Or i = 1 Then

.Cells(i + 1, "A").Resize(, 3).Insert Shift:=xlDown
.Cells(i + 1, "A").Value = bandText
.Cells(i + 1, "A").Resize(, 3).Interior.ColorIndex = 15
If testValue = 45 Then

testValue = 40
bandText = "40"
Else

testValue = 30
bandText = "30-35"
End If
End If
Next i

.Columns("C").Copy
.Columns("A").PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False
End Sub

[vishwakarma]

Thanks a lot; xld.. it working now... :yes