Macro or VB in Excel 2007

Solved/Closed
Report
Posts
4
Registration date
Monday January 16, 2012
Status
Member
Last seen
January 16, 2012
-
 Blocked Profile -
Hi.

I have next to no experience with macros & VB. But I have a problem that I need resolved.
I have 11 sheets in excel. 10 sheets need to pull information from sheet1.

This is for chefs at a catering service.

I have a key word in column A to differentiate each line of information.
What I need is...
Sheet 2 & 3 to pull the complete line from sheet1 if the word in column A is "Hot".
Sheet 4 & 5 to pull the complete line from sheet 1 if the word in column A is "Cold".
Sheet 6 to pull the complete line from sheet 1 if the word in column A is "Bulk".
Sheet 8 & 9 to pull the complete line from sheet 1 if the word in column A is "Pastry".
Sheet 10 to pull the complete line from sheet 1 if the word in column A is "Pres".
The other sheets I have covered.

I created a macro to sort the sheets based on three columns. It would be nice if this macro automatically ran everytime information was added to the sheet. Not to a certain line but to any area of the sheet to keep the information in order.

Any help would be greatly appreciated. Also, please be gentle because I am hardly macro literate.

1 reply

Posts
4
Registration date
Monday January 16, 2012
Status
Member
Last seen
January 16, 2012
1
OK So I have figured my problem out.
Here is the code I used.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nxtRow As Integer
'Determine if change was to Column H (8)
 If Target.Column = 8 Then
'If Yes, Determine if cell = Hot
  If Target.Value = "H" Then
'If Yes, find next empty row in Sheet 2
   nxtRow = Sheets(2).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 2
    Target.EntireRow.Copy _
     Destination:=Sheets(2).Range("A" & nxtRow)
'If Yes, find next empty row in Sheet 3
   nxtRow = Sheets(3).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 3
    Target.EntireRow.Copy _
     Destination:=Sheets(3).Range("A" & nxtRow)
 End If
 End If

'Determine if change was to Column H (8)
 If Target.Column = 8 Then
'If Yes, Determine if cell = Cold
  If Target.Value = "C" Then
'If Yes, find next empty row in Sheet 4
   nxtRow = Sheets(4).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 4
    Target.EntireRow.Copy _
     Destination:=Sheets(4).Range("A" & nxtRow)
'If Yes, find next empty row in Sheet 5
   nxtRow = Sheets(5).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 3
    Target.EntireRow.Copy _
     Destination:=Sheets(5).Range("A" & nxtRow)
 End If
 End If
 
 'Determine if change was to Column H (8)
 If Target.Column = 8 Then
'If Yes, Determine if cell = Presentation
  If Target.Value = "P" Then
'If Yes, find next empty row in Sheet 8
   nxtRow = Sheets(8).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 8
    Target.EntireRow.Copy _
     Destination:=Sheets(8).Range("A" & nxtRow)
 End If
 End If
 
'Determine if change was to Column H (8)
 If Target.Column = 8 Then
'If Yes, Determine if cell = Pastry
  If Target.Value = "PY" Then
'If Yes, find next empty row in Sheet 10
   nxtRow = Sheets(10).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 10
    Target.EntireRow.Copy _
     Destination:=Sheets(10).Range("A" & nxtRow)
'If Yes, find next empty row in Sheet 12
   nxtRow = Sheets(11).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 12
    Target.EntireRow.Copy _
     Destination:=Sheets(11).Range("A" & nxtRow)
 End If
 End If
 
'Determine if change was to Column H (8)
 If Target.Column = 8 Then
'If Yes, Determine if cell = Bulk
  If Target.Value = "B" Then
'If Yes, find next empty row in Sheet 6
   nxtRow = Sheets(6).Range("G" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 6
    Target.EntireRow.Copy _
     Destination:=Sheets(6).Range("A" & nxtRow)
 End If
 End If

 
End Sub


It repeats itself but it does work.
I just need these sheets to sort while they are being updated and everything is good.
1
Blocked Profile
Hi,

Thanks for sharing the solution with us.

Regards,
Moderator
0