I take back my comment earlier, this code works great thank you!
On Oct 8, 4:51 pm, Sam Mathai Chacko <samde...@gmail.com> wrote:
> Try this. Code with file attached.
>
> Sub Consolidator()
>
> Dim rngCell As Range
> Dim wks As Worksheet
>
> Application.ScreenUpdating = False
> For Each rngCell In Worksheets("Selections").Range("XColumn").Cells
> 'Where XColumns is a named range having the 3 columns where user marks X
> If rngCell.Value = "X" Then
> Worksheets("Data").UsedRange.AutoFilter 2, rngCell.Offset(,
> 1).Value
> If Worksheets("Data").Cells(Rows.Count, 2).End(xlUp).Row > 1
> Then
> On Error Resume Next
> Set wks = Worksheets(rngCell.Offset(, 1).Value)
> Err.Clear: On Error GoTo -1: On Error GoTo 0
> If wks Is Nothing Then
> Set wks =
> ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
> wks.Name = Left(rngCell.Offset(, 1).Value, 31)
> Worksheets("Data").UsedRange.Copy wks.Cells(1)
> With wks.UsedRange
> .EntireRow.RowHeight = 40
> .EntireColumn.ColumnWidth = 200
> .EntireColumn.AutoFit
> .EntireRow.AutoFit
> .WrapText = True
> End With
> Else
> Worksheets("Data").Range(Worksheets("Data").Cells(2, 1),
> Worksheets("Data").Cells(Worksheets("Data").Cells(Rows.Count,
> 2).End(xlUp).Row, 5)).Copy wks.Cells(wks.Rows.Count, 2).End(xlUp).Offset(1,
> -1)
> End If
> Set wks = Nothing
> End If
> End If
> Next rngCell
> Worksheets("Data").AutoFilterMode = False
> Application.Goto Worksheets("Selections").Cells(1)
> Application.ScreenUpdating = True
>
> Set rngCell = Nothing
>
> End Sub
>
> On Sun, Oct 9, 2011 at 2:19 AM, Monizri <moni...@gmail.com> wrote:
> > The autofilter can be an alternative. Is it possible get the loop to
> > read into the second bit of code where it has "FHCX" and spit out
> > code that way? Thats where ive been racking my brain.
>
> > I do appreciate this Don
>
> > On Oct 8, 4:29 pm, "dguillett1" <dguille...@gmail.com> wrote:
> > > After looking at your file on the link provided it seems that you want to
> > > simply use data>autofilter>copy. If that is correct, it is fairly easy to
> > > write a macro to loop thru looking for X and then filter the data sheet
> > by
> > > that value and copy to the other sheets. Is that what you want?
>
> > > Sub filterandcopy()
> > > 'for each c in activesheet.usedrange.specialcells(xlce
> > > For Each c In Range("b2:b21,f2:f21,j2,j21")
> > > If UCase(c) = "X" Then
> > > 'MsgBox c.Row
> > > End If
> > > Next c
> > > End Sub
>
> > > Don Guillett
> > > SalesAid Software
> > > dguille...@gmail.com
>
> > > -----Original Message-----
> > > From: Monizri
> > > Sent: Saturday, October 08, 2011 2:56 PM
> > > To: MS EXCEL AND VBA MACROS
> > > Subject: Re: $$Excel-Macros$$ Read a menu and produce results
>
> > > awesome, here's a linkhttp://www.box.net/shared/o0uley3sbbh3fxu315ou
>
> > > The tabs that say FHCX, FHMX, and FNMX are what i wanted the results
> > > to be once the loop happened...
>
> > > any ideas for code or logic i can use?
>
> > > On Oct 8, 3:29 pm, Sam Mathai Chacko <samde...@gmail.com> wrote:
> > > > Just go to your gmail inbox, and reply to the mail.
>
> > > > OR
>
> > > > Go to box.net, and you can upload your file there, and provide a link
> > > > here.
>
> > > > Regards,
>
> > > > Sam
>
> > > > On Sun, Oct 9, 2011 at 12:57 AM, Monizri <moni...@gmail.com> wrote:
> > > > > Thanks Don, I can try FIND instead of looping, i am trying to add my
> > > > > file but i don't see anywhere i can attach my file. Do you know
> > where?
>
> > > > > Tx
>
> > > > > Matt
>
> > > > > On Oct 8, 11:47 am, "dguillett1" <dguille...@gmail.com> wrote:
> > > > > > It would be helpful to post your files with before/after examples.
> > I
> > > > > would
> > > > > > think that instead of using a loop you would use FIND (look in vba
> > > > > > help)
>
> > > > > > Don Guillett
> > > > > > SalesAid Software
> > > > > > dguille...@gmail.com
>
> > > > > > -----Original Message-----
> > > > > > From: Monizri
> > > > > > Sent: Saturday, October 08, 2011 9:01 AM
> > > > > > To: MS EXCEL AND VBA MACROS
> > > > > > Subject: Re: $$Excel-Macros$$ Read a menu and produce results
>
> > > > > > Hi Sam, I apologize for not being clear, i was sure how to pose the
> > > > > > question.
> > > > > > I have two spreadsheets. One with a menu with a bunch of criteria
> > (of
> > > > > > which you can select the criteria you want by placing an "X" in a
> > > > > > designated area ). The second spreadsheet will have data i need to
> > > > > > search through. So based on the selections on the menu page, i want
> > it
> > > > > > to loop through the data on the data page a find the criteria
> > > > > > selections in the data sheet and pick the data in that row and post
> > it
> > > > > > in a new tab/worksheet.
>
> > > > > > -Matt
>
> > > > > > I have two pieces of code i've been trying to work with but am
> > unsure
> > > > > > how to connect them. The first one reads a menu and the ranges and
> > > > > > thats it. The second one, will create a new tab with search
> > results.
> > > > > > How can i get the two codes to work together? to read the menu and
> > > > > > produce the results...
>
> > > > > > 1) 'reads the menu
>
> > > > > > Sub Read_Geographic_Menu()
> > > > > > Sheets("Selections").Select
> > > > > > Range("A1").Select
>
> > > > > > i_state = 0
> > > > > > g_num_select_states = 0
>
> > > > > > For icol = 1 To STATES_NUM_COLS
> > > > > > For irow = 1 To STATES_PER_COL
> > > > > > i_state = i_state + 1
> > > > > > g_state_select(i_state) = False
> > > > > > g_state_postal(i_state) = Trim(Range("m6StatePostal" &
> > > > > > icol).Cells(irow))
> > > > > > g_state_name(i_state) = Trim(Range("m6StatesNames" &
> > > > > > icol).Cells(irow))
> > > > > > g_state_id_number(i_state) = i_state
> > > > > > If Range("m6States" & icol).Cells(irow) <> "" Then
> > > > > > g_state_select(i_state) = True
> > > > > > g_num_select_states = g_num_select_states + 1
> > > > > > End If
> > > > > > Next irow
> > > > > > Next icol
> > > > > > End Sub
>
> > > > > > 2) searches for data (in this case "FHCX") and pulls the column
> > data i
> > > > > > need.
> > > > > > Sub ServiceReport()
> > > > > > ' Copy the selected range to the Report worksheet
> > > > > > Dim WSD As Worksheet ' Data worksheet
> > > > > > Dim WSR As Worksheet ' Report worksheet
>
> > > > > > Set WSD = Worksheets("Data")
>
> > > > > > ' Add a new worksheet to this workbook
> > > > > > Set WSR = Worksheets.Add(after:=Worksheets("Data"))
>
> > > > > > ' Rename the new worksheet & set up titles
> > > > > > WSR.Name = "Service"
> > > > > > WSR.Cells(1, 1) = "Service Report"
> > > > > > WSR.Cells(1, 1).Font.Size = 14
>
> > > > > > WSD.Range("A1:E1").Copy Destination:=WSR.Cells(3, 1)
> > > > > > NextRow = 4
>
> > > > > > ' Loop through all records on WSD
> > > > > > FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
> > > > > > For i = 2 To FinalRow
> > > > > > If WSD.Cells(i, 2) = "FHCX" Then
> > > > > > ' Copy this record to the next row on WSR
> > > > > > WSD.Cells(i, 1).Resize(1, 5).Copy Destination:=WSR.Cells(NextRow,
> > 1)
> > > > > > NextRow = NextRow + 1
> > > > > > End If
> > > > > > Next i
>
> > > > > > ' Make sure WSR is the active sheet
> > > > > > WSR.Select
>
> > > > > > ' Report that the macro is done
> > > > > > MsgBox Prompt:=NextRow - 4 & " service records copied to the
> > service
> > > > > > report."
>
> > > > > > End Sub
>
> > > > > > On Oct 8, 12:17 am, Sam Mathai Chacko <samde...@gmail.com> wrote:
> > > > > > > I believe the forum is not able to comprehend what 'can i get
> > excel
> > > > > > > to
> > > > > > > read
> > > > > > > a menu with selections using "X" in a cell' is trying to convey.
> > > > > > > Maybe
> > > > > you
> > > > > > > want to rephrase it, or share an example of what you are trying
> > to
> > > > > > > do.
>
> > > > > > > Sam
>
> > > > > > > On Fri, Oct 7, 2011 at 10:55 PM, Monizri <moni...@gmail.com>
> > wrote:
> > > > > > > > Hi, I have the following code that searches for data based on
> > what
> > > > > > > > i
> > > > > > > > type in it (in this case it is "FHCX") and posts it in a new
> > > > > > > > sheet.
> > > > > > > > How can i get excel to read a menu with selections using "X" in
> > a
> > > > > cell
> > > > > > > > and feed it into the code below to produce results on a new
> > tab?
>
> > > > > > > > Sub ServiceReport()
> > > > > > > > ' Copy the selected range to the Report worksheet
> > > > > > > > Dim WSD As Worksheet ' Data worksheet
> > > > > > > > Dim WSR As Worksheet ' Report worksheet
>
> > > > > > > > Set WSD = Worksheets("Data")
>
> > > > > > > > ' Add a new worksheet to this workbook
> > > > > > > > Set WSR = Worksheets.Add(after:=Worksheets("Data"))
>
> > > > > > > > ' Rename the new worksheet & set up titles
> > > > > > > > WSR.Name = "Service"
> > > > > > > > WSR.Cells(1, 1) = "Service Report"
> > > > > > > > WSR.Cells(1, 1).Font.Size = 14
>
> > > > > > > > WSD.Range("A1:E1").Copy Destination:=WSR.Cells(3, 1)
> > > > > > > > NextRow = 4
>
> > > > > > > > ' Loop through all records on WSD
> > > > > > > > FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
> > > > > > > > For i = 2 To FinalRow
> > > > > > > > If WSD.Cells(i, 2) = "FHCX" Then
> > > > > > > > ' Copy this record to the next row on WSR
> > > > > > > > WSD.Cells(i, 1).Resize(1, 5).Copy
> > > > > > > > Destination:=WSR.Cells(NextRow, 1)
> > > > > > > > NextRow = NextRow + 1
> > > > > > > > End If
> > > > > > > > Next i
>
> > > > > > > > ' Make sure WSR is the active sheet
> > > > > > > > WSR.Select
>
> > > > > > > > ' Report that the macro is done
> > > > > > > > MsgBox Prompt:=NextRow - 4 & " service records copied to the
> > > > > > > > service report."
>
> > > > > > > > End Sub
>
> > > > > > > > --
>
> > ---------------------------------------------------------------------------
> > -------
> > > > > > > > Some important links for excel users:
> > > > > > > > 1. Follow us on TWITTER for tips tricks and links :
>
> ...
>
> read more »
>
> qryCMSFileBY 09-23-11.xlsm
> 223KViewDownload
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
