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
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Blocked Profile
Hi,

Thanks for sharing the solution with us.

Regards,
Moderator