Want to add additional columns to attached macro please

007juk

Board Regular
Joined
May 16, 2007
Messages
95
Hi,

Can someone help please. I don't know how to add addtional columns to the attached macro. At the moment when I run macro it provides me with one column of data with a heading. Want to add an extra four columns. The titles of columns can be col2, col3, col4 and col6.

Many thanks.

Code:
Sub ListTraining()
Dim LastRow As Long, i As Long, StartRow As Long, NameCol As Integer
Dim ISh As Worksheet, OSh As Worksheet, j As Long
StartRow = 2
NameCol = 1
Set ISh = ActiveSheet
LastRow = ISh.Cells(Rows.Count, NameCol).End(xlUp).Row
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Need Training").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Need Training"
Set OSh = Sheets("Need Training")
OSh.Cells(1, 1).Value = "Training overdue for Manual Handling"
j = 1
For i = StartRow To LastRow
If IsEmpty(ISh.Cells(i, NameCol + 1).Value) Then
j = j + 1
OSh.Cells(j, 1).Value = ISh.Cells(i, NameCol).Value
End If
Next i
OSh.Columns(1).EntireColumn.AutoFit
End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Joined
Jul 30, 2006
Messages
3,656
007juk,

Here you go:

Code:
Option Explicit
Sub ListTraining()
    Dim LastRow As Long, i As Long, StartRow As Long, NameCol As Integer
    Dim ISh As Worksheet, OSh As Worksheet, j As Long
    StartRow = 2
    NameCol = 1
    Set ISh = ActiveSheet
    LastRow = ISh.Cells(Rows.Count, NameCol).End(xlUp).Row
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Need Training").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Need Training"
    Set OSh = Sheets("Need Training")
    OSh.Cells(1, 1).Value = "Training overdue for Manual Handling"
    'Want to add an extra four columns. The titles of columns can be col2, col3, col4 and col6.
    OSh.Cells(1, 2).Value = "col2"
    OSh.Cells(1, 3).Value = "col3"
    OSh.Cells(1, 4).Value = "col4"
    OSh.Cells(1, 5).Value = "col6"
    j = 1
    For i = StartRow To LastRow
        If IsEmpty(ISh.Cells(i, NameCol + 1).Value) Then
            j = j + 1
            OSh.Cells(j, 1).Value = ISh.Cells(i, NameCol).Value
        End If
    Next i
    OSh.Columns(1).EntireColumn.AutoFit
End Sub

Have a great day,
Stan
 

Watch MrExcel Video

Forum statistics

Threads
1,130,447
Messages
5,642,209
Members
417,262
Latest member
andrewd1

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