Help needed with code to count & insert rows

mplees

Active Member
Joined
Feb 6, 2006
Messages
351
Hi,

Hope someone can help me out with this. In my workbook on sheet 1, I have a list of jobs & part numbers. On sheet 2 I have headings on alternate rows.

What I am trying to do is when I add data to sheet 1, I copy the inputted data & insert it into sheet 2. Difficult to explain, and I cannot post a sample sheet until I get home, but basically, the layout is:

Sheet 1

A B
1 574999
2 123456
3 456123
4 674556
5 654321
6 574998
7 650987


and so on. The first problem is that the number of items is variable - there could be 1 item or 30 items. The constant is that the job number is always in column A. On sheet 2 I have:

A B
1 =Sheet1!A1
2
3 = next job number on sheet 1
4

and so on. Does anyone have thoughts as to how this could be acomplished? The other important thing is that the formatting on sheet 2 needs to be retained when the rows are inserted.

Hope someone can help me out - all assistance gratefully received as always.

Regards,

Mark
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

mplees

Active Member
Joined
Feb 6, 2006
Messages
351
Hi,

After much head scratching, I cobbled together the following code:

Code:
Private Sub CommandButton1_Click()
Dim vRng1 As Range, vRng2 As Range, vRng3 As Range, vRng4 As Range
Dim vCell1 As Long, vCell2 As Long, vCell3 As Long, vCell4 As Long
Dim vCell5 As Long, vCell6 As Long

Set vRng1 = Sheets("WIP data").Cells(Rows.Count, "B").End(xlUp)
Set vRng2 = Sheets("WIP data").Cells(Rows.Count, "A").End(xlUp)
Set vRng3 = Sheets("Workload").Cells(Rows.Count, "A").End(xlUp)


vCell1 = vRng1.Row
vCell2 = vRng2.Row
vCell3 = vCell1 - vCell2 + 1
vCell4 = vRng3.Row + vCell3
vCell5 = vRng3.Row

Sheets("Workload").Activate
    ActiveSheet.Range("A" & vCell5 & ":A" & vCell4).EntireRow.Insert shift:=xlDown
Sheets("WIP data").Activate
    Range(vRng2.Address & ":" & vRng1.Address).Copy
Sheets("Workload").Activate
    ActiveSheet.Range("A" & vCell5).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Range("A" & vCell5 & ":J" & vCell5).Select
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
    Set vRng4 = Sheets("Workload").Cells(Rows.Count, "B").End(xlUp)
    vCell6 = vRng4.Row + 2
    ActiveSheet.Range("A" & vCell6).Select
End Sub

....probably very inefficient, has too many variables, etc., but it seems to work ok!

Regards,

Mark
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,543
Messages
5,832,356
Members
430,128
Latest member
ojl987

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top