Simple moving and sorting of information gone wrong - too many Ifs?

J

JD Taylor

New Member
Joined
Sep 2, 2014
Messages
31
Good afternoon,

Let me set the scene, I undergo projects in iterations as I am learning on the way. I am not experienced enough yet to tackle the whole project altogether, so I break it down to smaller more managable tasks.

I have hundreds of sheets, but only a few are relevant here today. On the sheet named (Consumer Logs) we have a list of clients in column A, from A5 down, and that list is expanding.
I am setting up an index for each of these clients, with sheets created for each client, that will be accessible from this name in column A via a hyperlink.
I can probably sort the hyperlink step shortly, no worries, however I am stuck at a previous step.

At present, I have the list of clients from A5 down (to about A271 but that's irrevelant), and the coding to move it not to another sheet yet (that's the next step) but to only the next column or two depending on what the data in another cell starts with.

For example, A5 has Bob Ainslie 23/12/76, A6 Charlie Allsworth 12/03/82, A7 Andrew Aman 01/01/91. This list is alphabetised by the surname than the first name elsewhere, I have brought it here for my convenience.
Column B has the surnames, so B5 is Ainslie, B6 Allsworth, A7 Aman. I put this here for the ease of having the surname more accessible for my coding (rather than being located halfway through a string where two first names could mess up any attempt at getting the middle).

What I am trying to is do is to list each person's name (sorted by their surname) under different columns. In C4 I have "A". In D4 I have "B". In E4 I have "C". All the way to AB which has "Z".
I have sort of got the code to do that, but there are errors. For some reason when I run the code, the first name with a surname sometimes enters in the cell above where it should be located. This could have something to do with the fact I have around 25 nested If - Else statements. Possibly too many operations going on messing up the cell destinations.

I know there is a way to get rid of that many If's by making another array and loop or something, but it is a little bit past me at present.

Here's the code.



Private Sub SortNames()
Dim rSourceRange As Range
Dim rDestinRange As Range
Dim sLResult As String
Dim i As Integer
'Dim iA As Integer

Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("B5:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("C5:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For i = 1 To rSourceRange.Count

Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("B5:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("C5:C" & Cells(Rows.Count, "C").End(xlUp).Row)
If Left(rSourceRange(i, 1).Value, 1) = "A" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("C5:C" & Cells(Rows.Count, "C").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "B" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("D5:D" & Cells(Rows.Count, "D").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "C" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("E5:E" & Cells(Rows.Count, "E").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "D" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("F5:F" & Cells(Rows.Count, "F").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "E" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("G5:G" & Cells(Rows.Count, "G").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "F" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("H5:H" & Cells(Rows.Count, "H").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "G" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("I5:I" & Cells(Rows.Count, "I").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "H" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("J5:J" & Cells(Rows.Count, "J").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "I" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("K5:K" & Cells(Rows.Count, "K").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "J" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("L5:L" & Cells(Rows.Count, "L").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "K" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("M5:M" & Cells(Rows.Count, "M").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "L" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("N5:N" & Cells(Rows.Count, "N").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "M" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("O5:O" & Cells(Rows.Count, "O").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "N" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("P5:P" & Cells(Rows.Count, "P").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "O" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("Q5:Q" & Cells(Rows.Count, "Q").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "P" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("R5:R" & Cells(Rows.Count, "R").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "Q" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("S5:S" & Cells(Rows.Count, "S").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "R" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("T5:T" & Cells(Rows.Count, "T").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "S" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("U5:U" & Cells(Rows.Count, "U").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "T" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("V5:V" & Cells(Rows.Count, "V").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "U" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("W5:W" & Cells(Rows.Count, "W").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "V" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("X5:X" & Cells(Rows.Count, "X").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "W" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("Y5:Y" & Cells(Rows.Count, "Y").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "X" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("Z5:Z" & Cells(Rows.Count, "Z").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "Y" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("AA5:AA" & Cells(Rows.Count, "AA").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
Else
If Left(rSourceRange(i, 1).Value, 1) = "Z" Then
Set rSourceRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rDestinRange = ActiveWorkbook.Worksheets("Consumer Logs").Range("AB5:AB" & Cells(Rows.Count, "AB").End(xlUp).Row)
rDestinRange(i, 1).Value = rSourceRange(i, 1).Value
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next i
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
Hi
Is this the sort of thing you're looking for?
Code: 
 Sub SortNames()

    Dim CNum As Integer
    Dim i As Integer

    With ActiveWorkbook.Worksheets("Consumer Logs")
        For i = 5 To .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Rows.Count
            CNum = Asc(Left(.Range("B" & i), 1)) - 62
            .Range("A" & i).Copy .Cells(i, CNum).End(xlUp).Offset(1)
        Next i
    End With

End Sub
 
Upvote 0
Fluff said:
Hi
Is this the sort of thing you're looking for?
Code: 
 Sub SortNames()

    Dim CNum As Integer
    Dim i As Integer

    With ActiveWorkbook.Worksheets("Consumer Logs")
        For i = 5 To .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Rows.Count
            CNum = Asc(Left(.Range("B" & i), 1)) - 62
            .Range("A" & i).Copy .Cells(i, CNum).End(xlUp).Offset(1)
        Next i
    End With

End Sub
Click to expand...

Hi Fluff again,

That nearly got it.

In column A (from A5 down to indefinite) where I have the client names, instead of just the names of people written in text I have "=ConsumerNames!A4" and so on down. Column B is also technically "=ConsumerNames!B4" and so on down. What your code has done has (which has worked well if I had explained myself more clearly) is to enter in the fields under Column C (which for me was surnames starting with A, and Col D surnames with B...) an extension of 'ConsumerNames!' being "ConsumerNames!C4" and in the next col "ConsumerNames!D4"...

But only in the fields where something should be entered. Meaning in the Col for surnames starting with A, there are eight people, so eight fields are filled in. Under B, 20 people, so 20 fields filled in. Interesting indeed.

Let me have a fiddle, I have a meeting now but should be able to work on it again in a few hours.

Thanks Fluff,
 
Upvote 0
JD Taylor said:
Hi Fluff again,

That nearly got it.

In column A (from A5 down to indefinite) where I have the client names, instead of just the names of people written in text I have "=ConsumerNames!A4" and so on down. Column B is also technically "=ConsumerNames!B4" and so on down. What your code has done has (which has worked well if I had explained myself more clearly) is to enter in the fields under Column C (which for me was surnames starting with A, and Col D surnames with B...) an extension of 'ConsumerNames!' being "ConsumerNames!C4" and in the next col "ConsumerNames!D4"...

But only in the fields where something should be entered. Meaning in the Col for surnames starting with A, there are eight people, so eight fields are filled in. Under B, 20 people, so 20 fields filled in. Interesting indeed.

Let me have a fiddle, I have a meeting now but should be able to work on it again in a few hours.

Thanks Fluff,
Click to expand...



Lol,

To bypass the references to another sheet not making it work, I referred the code directly to the original sheet. Again, very nearly. Unfortunately, the original sheet isn't pure text but concatenated phrases. So it copied concatenated phrases throughout. I have tried using TEXT() formula in the cell to eliminate the concatenation but this hasn't quite worked either.

Still working on it
 
Upvote 0
Ok, how about this
Code: 
 Sub SortNames()

    Dim CNum As Integer
    Dim i As Long

With Application
    .CutCopyMode = False
    .ScreenUpdating = False
End With

    With ActiveWorkbook.Worksheets("Consumer Logs")
        For i = 5 To .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Rows.Count
            CNum = Asc(UCase(Left(.Range("B" & i), 1))) - 62                               
            .Range("A" & i).Copy
            .Cells(i, CNum).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
        Next i
    End With

With Application
    .ScreenUpdating = True
End With

End Sub
 
Upvote 0
Better yet
Code: 
Option Explicit

 Sub SortNames()

    Dim CNum As Integer
    Dim i As Long

Application.ScreenUpdating = False

    With ActiveWorkbook.Worksheets("Consumer Logs")
        For i = 5 To .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Rows.Count
            CNum = Asc(UCase(Left(.Range("B" & i), 1))) - 62                               
            .Cells(i, CNum).End(xlUp).Offset(1) = .Range("A" & i).Value
        Next i
    End With

Application.ScreenUpdating = True


End Sub
 
Upvote 0
Fluff said:
Better yet
Code: 
Option Explicit

 Sub SortNames()

    Dim CNum As Integer
    Dim i As Long

Application.ScreenUpdating = False

    With ActiveWorkbook.Worksheets("Consumer Logs")
        For i = 5 To .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Rows.Count
            CNum = Asc(UCase(Left(.Range("B" & i), 1))) - 62                               
            .Cells(i, CNum).End(xlUp).Offset(1) = .Range("A" & i).Value
        Next i
    End With

Application.ScreenUpdating = True


End Sub
Click to expand...

Mate you got it.

Mainly just by adding UCase in... wow (and making it more efficient by instead of copying pasting, making this equal that).
So, UCase cares not for the reference if a formula is used, but looks at the string displayed and makes the first character uppercase - in effect skipping past the issues that were messing it up.

Legend bypass mate. Thank you, I most certainly will remember that.

Cheers,
 
Upvote 0
(y)
Glad to be able to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
record changes to a worksheet - (2)
Replies
1
Views
119
Joe4
Joe4
I
  • Question
Macro recorded to sort colm,n A-Z so now need to condense it
Replies
4
Views
79
Micron
M
F
  • Question
VBA Code to record changes/logs modification needed?
Replies
0
Views
64
FGaxha
F
E
  • Solved
ActiveCell vs Active range search
Replies
3
Views
227
Joe4
Joe4
B
  • Question
How to Create a Loop to ignore BLANK CELLS
Replies
3
Views
238
Alex Blakenburg
A

Forum statistics

Threads
1,214,987
Messages
6,122,618
Members
449,092
Latest member
amyap

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top