PDA

View Full Version : [SOLVED] Need Help Wrting This. (If from list, Then, If blanks, New Column)



taylorbrewed
06-21-2017, 06:04 AM
Hi, I'm new to Excel and VBA. I'm trying to learn on my own but have yet to find a answer for a way to accomplish what I'm trying to do.

I have one sheet in column(A) I have multiple words in different cells. In my example it is names and fruits.
I want to be able to separate the words into there own separate sheet if the word appears.
I also need it to separate the words into a different column in its appropriate sheet if a blank cell is shown.

I'm attach a example excel file.

In my example in column A-

Bill


Bob


Kiwi


Hank


Harry


Fred





Bill


Apple


Kiwi


Hank


Harry





Mike


Orange


John


Fred



I need Bill, Bob, Hank, Harry, Fred to go to a sheet named 'Names" into column A - Kiwi Will go to its own separate sheet named "Fruit" in column A
Because there is a blank cell in between my information. I need to to move over a column in their appropriate sheets
Bill, Hank, Harry will go to sheets named "names" and now to column B. Apple, and Kiwi will move to Sheet "Fruit" and into column B
Mike, John Fred- Sheet "Names" Column C. Orange to sheet "Fruit" column C.

I need this to continue on for as long as possible because I don't know how much information I will have in the original sheet where all there information is in Column A.

I hope how I'm explaining this makes sense, and I'm sure will all your bright minds, someone will be able to tackle this challenge for me.

Thanks

p45cal
06-21-2017, 06:19 AM
Although it's quite easy for us humans to tell the diffrence between fruit and names. the computer hasn't a hope without complete lists of what are names and what are fruit.
I say quite easy; but it isn't necessarily that easy; what do you do with the likes of Cherry, Apple (Gyneth Paltrow daughter), Olive, Huckleberry (Finn), Kiwi, Damson, Cerise, Peach, Clementine (Churchill), all of which are names and fruit?
Another way is to mark (in an adjcent column in Sheet1) those items which are names, or those which are fruit.. or both.

p45cal
06-21-2017, 06:23 AM
Although it's quite easy for us humans to tell the diffrence between fruit and names. the computer hasn't a hope without complete lists of what are names and what are fruit.
I might have goofed here; could the sheet tab List be those lists? or is that sheet to be generated too?

taylorbrewed
06-21-2017, 06:26 AM
p45Cal, I understand what you're saying, In the attached file called example I have a separate sheet called list. This sheet has dedicated list for names and fruit. I figured excel would be able to tell if information came from these set list.

taylorbrewed
06-21-2017, 06:28 AM
p45cal, you're correct I just named the sheet as list. In my real excel it is called inputs.

taylorbrewed
06-21-2017, 06:30 AM
The list will not need to be generated as I will be providing that information

p45cal
06-21-2017, 06:46 AM
Sub blah()
Sheets("Names").Cells.ClearContents
Sheets("Fruit").Cells.ClearContents

DestnColumn = 1
For Each are In Sheets("Sheet1").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
'are.Select
NameDestnRow = 1: FruitDestnRow = 1
For Each cll In are.Cells
'cll.Select
CurrentItem = Application.Trim(cll.Value)
Set NameFound = Sheets("List").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not NameFound Is Nothing Then
Sheets("Names").Cells(NameDestnRow, DestnColumn) = CurrentItem
NameDestnRow = NameDestnRow + 1
End If
Set FruitFound = Sheets("List").Columns(3).Find(what:=cll.Value, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not FruitFound Is Nothing Then
Sheets("Fruit").Cells(FruitDestnRow, DestnColumn) = CurrentItem
FruitDestnRow = FruitDestnRow + 1
End If
Next cll
DestnColumn = DestnColumn + 1
Next are
End Sub
You have a trailing space after the name Bob in Sheet1 (And Hank appears twice, once with a trailing space and once without!). This doesn't matter as I've included Application.Trim in the code, however, it's important that the List sheet entries contain no leading/trailing spaces, otherwise things may not be found.

Paul_Hossler
06-21-2017, 06:50 AM
Another way, this bumps the output over a column each time it finds a blank in the data



Option Explicit
Sub MoveData()
Dim wsList As Worksheet, wsNames As Worksheet, wsFruits As Worksheet, wsData As Worksheet
Dim rNames As Range, rFruits As Range, rData As Range
Dim colNames As Long, colFruit As Long ' columns to put the data in
Dim rowIndex As Long
Dim rDestination As Range

'init (need Set keyword for objects)
Set wsList = Worksheets("List")
Set wsNames = Worksheets("Names")
Set wsFruits = Worksheets("Fruit")
Set wsData = Worksheets("Sheet1")

Set rNames = wsList.Columns(1)
Set rFruits = wsList.Columns(3)
'A1 to the LAST cell in col A on the sheet up to the first non-blank cell (or A17)
Set rData = Range(wsData.Cells(1, 1), wsData.Cells(wsData.Rows.Count, 1).End(xlUp))

'clear all old data
wsNames.Cells(1, 1).CurrentRegion.ClearContents
wsFruits.Cells(1, 1).CurrentRegion.ClearContents


colNames = 1
colFruit = 1

Application.ScreenUpdating = False


'clean the data -- you have trailing blanks in some
For rowIndex = 1 To rNames.Cells(1, 1).CurrentRegion.Rows.Count
rNames.Cells(rowIndex, 1).Value = Trim(rNames.Cells(rowIndex, 1).Value)
Next rowIndex
For rowIndex = 1 To rFruits.Cells(1, 1).CurrentRegion.Rows.Count
rFruits.Cells(rowIndex, 1).Value = Trim(rFruits.Cells(rowIndex, 1).Value)
Next rowIndex
For rowIndex = 1 To rData.Rows.Count
rData.Cells(rowIndex, 1).Value = Trim(rData.Cells(rowIndex, 1).Value)
Next rowIndex



'go down rData
With rData ' anything that starts with a 'dot' 'belongs' to this

For rowIndex = 1 To .Rows.Count

'if blank move over one column
If Len(.Cells(rowIndex, 1).Value) = 0 Then
colNames = colNames + 1
colFruit = colFruit + 1
Else
'is it in the Names list?
If Not IsError(Application.Match(.Cells(rowIndex, 1).Value, rNames, 0)) Then
Set rDestination = wsNames.Cells(wsNames.Rows.Count, colNames).End(xlUp)
'if blank this is top row, if not blank then go one down
If Len(rDestination.Value) > 0 Then Set rDestination = rDestination.Offset(1, 0)
rDestination.Value = .Cells(rowIndex, 1).Value

'is it in the Fruit list?
ElseIf Not IsError(Application.Match(.Cells(rowIndex, 1).Value, rFruits, 0)) Then
Set rDestination = wsFruits.Cells(wsFruits.Rows.Count, colNames).End(xlUp)
'if blank this is top row, if not blank then go one down
If Len(rDestination.Value) > 0 Then Set rDestination = rDestination.Offset(1, 0)
rDestination.Value = .Cells(rowIndex, 1).Value
Else
MsgBox .Cells(rowIndex, 1).Value & " not a Name or Fruit"
End If
End If
Next rowIndex
End With
Application.ScreenUpdating = True
MsgBox "All Done"
End Sub

taylorbrewed
06-21-2017, 06:58 AM
WOW THANK YOU this is exactly what I needed.

Paul_Hossler
06-21-2017, 07:07 AM
Trace through the code and comments (P45Cal's and mine) to learn and understand

There are more efficient (probably) ways to do a lot of this, but I opted for straight-forwardness (assuming that's a word). P45cal's is more concise and possibly more efficient

Use [Thread Tools] above your first post to make it [Solved] if there's nothing more

taylorbrewed
06-21-2017, 08:12 AM
19556Thanks, I will make sure to mark it as solved as soon as I figure out how to get it to work in my exact excel spreadsheet. I hate to make people do my work and I want to learn, that is why I just used a example sheet. I'm currently trying to get it to work in my sheet. Once I get it to work I will mark this as solved. Until then you both have been very helpful and I would like to keep it open for a little while I get this worked out. Cheers

I'm going to post my exact sheet and maybe if you guys find time can take a look at it and it might speed up my questions in the future as I'm trying to add my own sheets to the code you both have wrote.

In my sheet. Recipes that is what I was using in my example sheet 1. I need column A to move to Either Grain2, Hop2 or Other2. I'm using the list used on the sheet called Inputs for my list.

taylorbrewed
06-21-2017, 02:56 PM
I have yet to get this to work using my original spreadsheet. Would either of you be willing to help?

p45cal
06-21-2017, 03:05 PM
Sub MoveData()
Sheets("Grain2").Cells.ClearContents
Sheets("Hop2").Cells.ClearContents

DestnColumn = 1
For Each are In Sheets("Recipe").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
'are.Select
GrainDestnRow = 1: HopDestnRow = 1
For Each cll In are.Columns(1).Cells'deals with he merged cells (try not to use merged cells with VBA - they're very hard work!)
'cll.Select
CurrentItem = Application.Trim(cll.Value)
Set GrainFound = Sheets("Inputs").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not GrainFound Is Nothing Then
Sheets("Grain2").Cells(GrainDestnRow, DestnColumn) = CurrentItem
GrainDestnRow = GrainDestnRow + 1
End If
Set HopsFound = Sheets("Inputs").Columns(3).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not HopsFound Is Nothing Then
Sheets("Hop2").Cells(HopDestnRow, DestnColumn) = CurrentItem
HopDestnRow = HopDestnRow + 1
End If
Next cll
DestnColumn = DestnColumn + 1
Next are
End Sub

Problems:
Merged columns A and B in Recipe sheet
Several syntax errors (Recipe instead of Sheets)
Names of variables not consistent.

For this last, I should have included some Dim statements at the top of the sub's code as well as a single Option Explicit line at the top of the code module:

Dim DestnColumn, are, GrainDestnRow, HopDestnRow, cll, CurrentItem, GrainFound, HopsFound
and this would have shown up spelling differences.

taylorbrewed
06-21-2017, 03:15 PM
Thank you. I will try it right after dinner.

p45cal
06-21-2017, 03:17 PM
Some of the problems highlighted:

Sub MoveData()
Sheets("Grain2").Cells.ClearContents
Sheets("Hop2").Cells.ClearContents

DestnColumn = 1
For Each are In Recipe("Recipe").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
'are.Select
Grain2DestnRow = 1: Hop2DestnRow = 1
For Each cll In are.Cells
'cll.Select
CurrentItem = Application.Trim(cll.Value)
Set GrainFound = Recipe("Inputs").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not GrainFound Is Nothing Then
Sheets("Grain2").Cells(GrainDestnRow, DestnColumn) = CurrentItem
GrainDestnRow = GrainDestnRow + 1
End If
Set HopsFound = Recipe("Inputs").Columns(3).Find(what:=cll.Value, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False) 'my mistake:cll.value should be CurrentItem, but it wouldn't have mattered.
If Not HopsFound Is Nothing Then
Sheets("Hops2").Cells(HopsDestnRow, DestnColumn) = CurrentItem
HopsDestnRow = HopsDestnRow + 1
End If
Next cll
DestnColumn = DestnColumn + 1
Next are
End Sub

End Sub


How many columns will you be searching (curtrently only 2)? If more than 4 then there's probably some shorter code we can use.

taylorbrewed
06-21-2017, 03:46 PM
Currently I'm only search 3 columns I go to a fourth but no more than 4

I tried adding Others to search list and put data into sheet others2.
Your code worked perfectly for search the 2 columns but when I added a third I did something wrong. I keep getting a error.
Below is what code I have and I made BOLD and Underlined what the debugger is saying is the issue.
Another question I have is are my sheet names and my list names to similar that it is making vba work harder?
I also unmerged cell a and b on the recipe sheet.
Thanks Again

Sub MoveData()
Sheets("Grain2").Cells.ClearContents
Sheets("Hop2").Cells.ClearContents
Sheets("Other2").Cells.ClearContents

DestnColumn = 1
For Each are In Sheets("Recipe").Columns(1).SpecialCells(xlCellTypeConstants, 2).Areas
'are.Select
GrainDestnRow = 1: HopDestnRow = 1
For Each cll In are.Columns(1).Cells 'deals with he merged cells (try not to use merged cells with VBA - they're very hard work!)
'cll.Select
CurrentItem = Application.Trim(cll.Value)
Set GrainFound = Sheets("Inputs").Columns(1).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not GrainFound Is Nothing Then
Sheets("Grain2").Cells(GrainDestnRow, DestnColumn) = CurrentItem
GrainDestnRow = GrainDestnRow + 1
End If
Set HopsFound = Sheets("Inputs").Columns(3).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not HopsFound Is Nothing Then
Sheets("Hop2").Cells(HopDestnRow, DestnColumn) = CurrentItem
HopDestnRow = HopDestnRow + 1
End If
Set OthersFound = Sheets("Inputs").Columns(5).Find(what:=CurrentItem, lookat:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
If Not OthersFound Is Nothing Then
Sheets("Other2").Cells(OthersDestnRow, DestnColumn) = CurrentItem
OthersDestnRow = OthersDestnRow + 1
End If
Next cll
DestnColumn = DestnColumn + 1
Next are
End Sub

taylorbrewed
06-21-2017, 03:56 PM
Just saw what you said about errors. Should I rename the sheet named "Recipe" back to Sheet?
Change sheet names that are too close to list named on input sheet?

taylorbrewed
06-21-2017, 04:51 PM
After Some playing around I got it to work. Thanks Again!!!!!!

p45cal
06-21-2017, 08:01 PM
Sheet names and variable names are fine as they are.
Change:
GrainDestnRow = 1: HopDestnRow = 1
To:
GrainDestnRow = 1: HopDestnRow = 1: OthersDestnRow = 1
(Not near a computer at the moment)