Solved: Conditional Output to Pre-Formatted Worksheet

Hello,

I am having a lot of difficulty reorganizing an input spreadsheet into an output spreadsheet using only formulas. I attempted to use various IF statements to reorganize this how I wanted but after hours with no avail it seems that VBA will need to be used because formulas cannot output to different cells even with a nested loop. But I am unfamiliar with VBA and programming in general...

The problem I have is a spreadsheet where contact information and details are copied in from a different sheet and must be reorganized to the correct format conditional on their address, email, and phone type.

For example, the sheet generally has two types of addresses (business and home) each with respective address details (street1, street 2, city, state, phone, country). The output sheet must organize all business addresses in one set of columns and all home addresses in another set of columns without displaying what type it is. Similarly for phone numbers, all business phone numbers must be in one column and all home phone numbers in another without displaying what type they actually are (Note- Some phone numbers are "mobile phone": is it possible to have these to output to home and be overwritten if home already exists?). Then finally again, all "main email"s must be in the work email and all "personal email"s must be grouped in the home email column in the output. If it helps, I attached an exact format example of the input I have and output I need for 1800 different rows.

If possible through the same macro, names must be concatenated and all unknowns in the group column removed but this can be done in a formula or find/replace. In any event, thank you for continuing to make excelforum.com a valuable resource. I've learned a lot reading the past few hours and hope to one day help others here where I can too.

I seem to be having the same issue as the user in the thread "Address Division and Reorganization" but I cannot post a link to this.

Thank you,
Sisu

Hi Susi

1st, Where does the data come from to fill the input sheet ?
2nd, The headings on sheet 2 do not match sheet1 are they suppose to ?

Come back with the answers and i will have look at it ok

Rob

Hi Rob,

Thank you for taking the time to look at this. To answer your questions:

1. The data to fill in the input sheets comes from this office's "donor management software" built on an access platform using query-by-example logic to run against its database. I have analyzed the lists it produces that becomes the input sheet and it seems impossible to do what's required within the system.

2. The headings on the second sheet are not supposed to match the headers on the first sheet. This should not be changed.

-Sisu

Susi

The reason for the 2nd question on the 1st sheet there is 1 column
"Institution" and on sheet 2 it is "Organisation" i persume this is where it is going?

Take a look for you tomorrow if thats ok

Rob

Hi Rob,

Yes the output format column headers may be different but you are correct in that they generally follow the input headers (business=work, org=institution). I am also learning vba quick the past few days to solve it too.

Thank you Rob,
Sisu

Many ways to do it, but something like this seems like the simplest

[vba]
Option Explicit
Const sInput As String = "Input"
Const sOutput As String = "Output"
Dim wsIn As Worksheet, wsOut As Worksheet
Sub Test1()
Dim rRow As Range

Set wsIn = Worksheets(sInput)
Set wsOut = Worksheets(sOutput)

wsOut.Cells.Clear

Application.ScreenUpdating = False
For Each rRow In wsIn.Cells(1, 1).CurrentRegion.Rows
Application.StatusBar = "Processing row " & rRow.Row
If rRow.Row > 1 Then Call MoveData(rRow)
Next
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Private Sub MoveData(R As Range)
Dim R1 As Range
Set R1 = wsOut.Rows(R.Row)
R1.Cells(1).Value = R.Cells(3).Value
If Len(R.Cells(4).Value) > 0 Then R1.Cells(1).Value = R1.Cells(1).Value & ", " & R.Cells(4).Value
R1.Cells(2).Value = R.Cells(1).Value
If Len(R.Cells(2).Value) > 0 Then R1.Cells(2).Value = R1.Cells(2).Value & " " & R.Cells(2).Value
R1.Cells(3).Value = R.Cells(5).Value
R1.Cells(4).Value = R.Cells(6).Value
R1.Cells(5).Value = R.Cells(7).Value
R1.Cells(6).Value = R.Cells(8).Value
R1.Cells(7).Value = R.Cells(9).Value
If UCase(Left(R.Cells(10).Value, 1)) = "H" Then
R1.Cells(15).Value = R.Cells(11).Value
R1.Cells(16).Value = R.Cells(12).Value
R1.Cells(17).Value = R.Cells(13).Value
R1.Cells(18).Value = R.Cells(14).Value
R1.Cells(19).Value = R.Cells(15).Value
R1.Cells(20).Value = R.Cells(16).Value
ElseIf UCase(Left(R.Cells(10).Value, 1)) = "B" Then
R1.Cells(8).Value = R.Cells(11).Value
R1.Cells(9).Value = R.Cells(12).Value
R1.Cells(10).Value = R.Cells(13).Value
R1.Cells(11).Value = R.Cells(14).Value
R1.Cells(12).Value = R.Cells(15).Value
R1.Cells(13).Value = R.Cells(16).Value
End If
If UCase(Left(R.Cells(17).Value, 1)) = "H" Then
R1.Cells(15).Value = R.Cells(18).Value
R1.Cells(16).Value = R.Cells(19).Value
R1.Cells(17).Value = R.Cells(20).Value
R1.Cells(18).Value = R.Cells(21).Value
R1.Cells(19).Value = R.Cells(22).Value
R1.Cells(20).Value = R.Cells(23).Value
ElseIf UCase(Left(R.Cells(17).Value, 1)) = "B" Then
R1.Cells(8).Value = R.Cells(18).Value
R1.Cells(9).Value = R.Cells(19).Value
R1.Cells(10).Value = R.Cells(20).Value
R1.Cells(11).Value = R.Cells(21).Value
R1.Cells(12).Value = R.Cells(22).Value
R1.Cells(13).Value = R.Cells(23).Value
End If
If UCase(Left(R.Cells(24).Value, 1)) = "H" Then
R1.Cells(21).Value = R.Cells(25).Value
ElseIf UCase(Left(R.Cells(24).Value, 1)) = "B" Then
R1.Cells(14).Value = R.Cells(25).Value
End If
If UCase(Left(R.Cells(26).Value, 1)) = "H" Then
R1.Cells(21).Value = R.Cells(27).Value
ElseIf UCase(Left(R.Cells(26).Value, 1)) = "B" Then
R1.Cells(14).Value = R.Cells(27).Value
End If
If UCase(Left(R.Cells(28).Value, 1)) = "H" Then
R1.Cells(24).Value = R.Cells(29).Value
ElseIf UCase(Left(R.Cells(28).Value, 1)) = "B" Then
R1.Cells(23).Value = R.Cells(29).Value
End If
If UCase(Left(R.Cells(30).Value, 1)) = "H" Then
R1.Cells(24).Value = R.Cells(31).Value
ElseIf UCase(Left(R.Cells(30).Value, 1)) = "B" Then
R1.Cells(23).Value = R.Cells(31).Value
End If

R1.Cells(22).Value = R.Cells(32).Value
R1.Cells(25).Value = R.Cells(33).Value
End Sub
[/vba]

Paul

Hi Paul

Nice job Paul , there was an error on "Set wsIn" err 9, have fixed it and added the " " on the sheets.
I have rem'd out the clear cells on sOutput just in case Susi wants to keep adding to the sheet ?

Susi
In the text there was something about removing the "Unknowns" ? is it just that field or the complete row ??

Posted a copy workbook back so you can see what its doing ok.

Rob

Rob342 --

Got it, but actually the Variable was named sInput, and was initialized by the Const to a value of Input.

So Worksheets(sInput) was equivalient to Worksheets("Input"), which was what the sample had (I hope)

One of the good programming practices I've learned from hanging out here in the forums was to use Const to pre-set all important, non-changing parameters in one place up front (or in a Globals module)

I usually prefix variables with a type identifier ('s' in the case of the string sInput) or sometimes gsInput or csInput for 'G'lobal or 'C'onst

[vba]
Const sInput As String = "Input"
Const sOutput As String = "Output"

Dim wsIn As Worksheet, wsOut As Worksheet

Set wsIn = Worksheets(sInput)
Set wsOut = Worksheets(sOutput)
[/vba]

There was a lot of polishing that could be done of course, error checking to be added, and the VBA was very brute force, but has the advantage of being very (IMHO) understandable and modifiable since I wasn't sure if I had the logic as desired

Paul

Susi

If you need to delete the rows with "Unknown" on the output sheet
put this code in that sheet or in a module if you want to create a button to operate them.
[vba]
Sub DeleteRowsUnknown()
'// Delete all rows where Column "Y" on Output sheet = "Unknown"
Dim lRow As Long, Nrow As Long
Dim OneCell As Range

lRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row

For Nrow = lRow To 1 Step -1
If Left(Cells(Nrow, "Y"), 2) = "Un" Then
Cells(Nrow, "Y").Rows.Delete
End If
Next

End Sub
[/vba]

Paul & Rob,

I am speechless :fainted:. I cannot express my thanks enough for this help and code. I tested Paul's first reply on my 1800 row sheet and it appears to work perfectly as designed. Admittedly, I cannot completely follow the reasoning behind your two recent discussion. Can I remain with Paul's code?

This is also perfect in that it's simple enough that I can keep up with the logic if I cannot at least create it myself. Perhaps in time with practice and study I can follow this excellent example.

There are just two minor issues I can see in the result of this code on the sheet. One is that it does not remove any instance of "unknown" in any cell in the "Groups" column.

The other issue regards email output but my database is not normalized before I can mention anything further. There are more than just two types of emails at the moment (e.g. "email 1"), but this will be fixed when I have access to it next week. But it should not be an issue when cleaned up into either business or personal email types.

A sincere thank you Paul for finding a solution where many others could not.

-Sisu

EDIT: I was posting as Rob put the unknown removal code up. Only the Unknown in the cell needs to be removed, not the whole row. I've done this before with find/replace and formulas but to have everything in one perhaps it's possible in VBA?

Susi

I didn't know whether it was the total row or just the cell

Have modified the code so it deletes only the "Unknown" ok

Please mark Thread as solved if it meets your needs ok

Rob

[vba]
Sub ClearCellUnknown()
'// Delete all Cells in Column "Y" on Output sheet if it = "Unknown"
Dim lRow As Long, Nrow As Long
Dim OneCell As Range

lRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row

For Nrow = lRow To 1 Step -1
If Left(Cells(Nrow, "Y"), 2) = "Un" Then
Cells(Nrow, "Y").ClearContents
End If
Next

End Sub

[/vba]

Something like this where you might have 'Unknown' (ex. in Col 13) will just avoid moving 'Unknown' in the first place

Instead of

[vba]
R1.Cells(17).Value = R.Cells(13).Value
[/vba]

you could use

[vba]
If Ucase (Left (R.Cells(13).Value ,1)) <> "U" then R1.Cells(17).Value = R.Cells(13).Value
[/vba]

BTW, I made my suggstion brute force, so you can easily modify it as your needs change, and so that you could follow the logic

It can can be really hard to trace through someone else's code

Of course, it would be faster to just code a .Replace at the end and get them all at once

Paul

This has been solved! Thank you all so much!