Adding Rows and Data based off Integer in Cell

[Caliber]

Hello Everyone,
This is my first time posting here. I have found myself at MrExcel a few times when I was working on ideas to expedite my workload by having Excel do as much of the work as possible. I would also like to point out that I am a little failure with Visual Basics and I’m always learning something new with Excel so I’m not an expert by any stretch.

At my place of business I receive an excel spreadsheet with information about our computers, what office they are in and how many computers are in the office.
Due to the way we have our computer naming convention each computer name has the office number in it as well as a corresponding computer number. An example of this is as follows…
.
|Office | Count | Wks Name |
|1235 | 1 | |
|7895 | 3 | |
|4521 | 2 | |

What I am trying to do is take this information and have it create a list in the column to the right of “Count” with the workstation names…
.
|Office | Count |Wks Name|
|1235 | 1 | 1235-01 |
|7895 | 3 | 7895-01 |
|____ | _ | 7895-02 |
|____ | | 7895-03 |
|4521 | 2 | 4521-01 |
| | | 4521-02 |

One major issue is, I cannot use Macros, it been disabled by group policy and is greyed out. However VBA does work as I was able to have it automatically insert rows. So far I have this with VBA and have attached it to the action of clicking a button. So far it only updates offices that have 1 or 2 computers, I haven’t tried to do more since I cannot get this one working. Any help or pointers would be greatly appreciated.

Sub btnUpdateList_Click()

' Finding the last row of column B'
Lastrow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row

' Stepping through the rows'
For i = Lastrow To 2 Step by – 1

' Finding the value of Column B for the current row '
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2).Value = "1" Then

'Setting Column C equal to Column A and adding "-01" to it for the current Row'
Cells(i, 3).Text = Rows(A, i) & "-01"
End If

' Finding the value of Column B for the current row '
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2).Value = "2" Then

' Setting Column C equal to Column A and adding "-01" to it for the current Row '
Cells(i, 3).Text = Rows(A, i) & "-01"

' Adding a new Row and setting Column C to Office Num and adding "-02"
ThisWorkbook.Worksheets("Sheet1").Rows(i + 1).Select
Selection.Insert Shift:=xlDown
Cells(i, 3).Text = Rows(A, i) & "-02"
End If

' Moving to the next Cell '
Next
sheet1.Cells(1, 1).Select

End Sub


From what I have seen in the forums there are a lot of very smart people who probably have a better way of doing this. I again would greatly appreciate any help or assistance. Thank you.

 

[Fluff]

Hi, welcome to the board.
Give this a go

Sub btnUpdateList_Click()

    Dim UsdRws As Long
    Dim Sht As Worksheet
    Dim Qty As Long
    Dim Cnt As Long
    
    Set Sht = ThisWorkbook.Worksheets("Sheet2")
    UsdRws = Sht.Range("B" & Rows.Count).End(xlUp).Row

    For Cnt = UsdRws To 2 Step -1
        Qty = Sht.Range("B" & Cnt).Value
        If Qty = 1 Then
            Sht.Range("C" & Cnt).Value = Sht.Range("A" & Cnt).Text & "-01"
        Else
            Sht.Rows(Cnt + 1).Resize(Qty - 1).Insert
            Sht.Rows(Cnt).Resize(Qty).FillDown
            Sht.Range("C" & Cnt).Value = Sht.Range("A" & Cnt).Text & "-01"
            Sht.Range("C" & Cnt).AutoFill Sht.Range("C" & Cnt).Resize(Qty), xlFillSeries
        End If
    Next Cnt

End Sub

It assumes that you have a header in row 1 with data starting in A2