Help Please

[Himszy]

Hi

I have a table with 7 columns and 100 rows in it. Down the first column
there are the numbers 1-100. The other 6 columns contain (words and then a
percentage next to them) X3. So i have:-

Numbers words1 per.1 words2 per.2 words3 per.3

Now, the percentages belong to the names before them. I need to list the
names next to the large number line but the percentage next to them need to
become the position on the line. If you get me. But also the words in column
words1 can't be mixed up with words2 or 3 , and the same for the other two.

So, if your still with me, which I hope you are, I need a code that can turn
this:-

100 Percentage11 98% Percentage21 95% Percentage31 94%
99 Percentage12 97% Percentage22 91% Percentage32 93%
98 Percentage13 92% Percentage23 95% Percentage33 97%
97 Percentage14 97% Percentage24 97% Percentage34 92%
96
95
94
93
92
.........

Into this:-

100
99
98 Percentage11
97 Percentage12 Percentage24 Percentage33
Percentage14
96
95 Percentage21
Percentage23
94
Percentage31
93 Percentage13 Percentage32
92
Percentage34
91 Percentage22


The percentages wont all be in the 90% region but its just an example


Thanks Michael

 

[Dave Peterson]

I put the text with similar percentages into the same cell (using alt-enters).

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCol As Long
Dim myVal As Variant
Dim myStr As String

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With newWks
With .Range("a1:a100")
.Formula = "=101-row()"
.Value = .Value
End With
End With

With curWks
For iCol = 2 To 6
Set myRng = .Range(.Cells(1, iCol), _
.Cells(.Rows.Count, iCol).End(xlUp))
For Each myCell In myRng.Cells
With myCell
If Trim(.Value) = "" Then
'do nothing
Else
'strip out ###% or _##%
myVal = Trim(Right(.Value, 4))
'remove the % and change it to a value
myVal = CLng(Left(myVal, Len(myVal) - 1))

myStr = newWks.Cells(101 - myVal, iCol).Value
If myStr = "" Then
'do nothing
Else
'add a vblf
myStr = myStr & vbLf
End If
myStr = myStr & Trim(Left(.Value, Len(.Value) - 4))
newWks.Cells(101 - myVal, iCol).Value = myStr
End If
End With
Next myCell
Next iCol
End With

With newWks.UsedRange
.Columns.ColumnWidth = 255
.Columns.AutoFit
.Rows.AutoFit
End With

End Sub


If you put borders around the range,
and on the format|cells|alignment tab
set the vertical alignment to center, it'll look prettier, too.

 

[Himszy]

Thanks Dave

I tried to run it but it came up with error mismatch on the
myVal = CLng(Left(myVal, Len(myVal) - 1)) line.

Any ideas?

Thanks Michael

 

[Dave Peterson]

Just a guess...

What's in that cell that's causing the trouble?

Maybe you could show what's there before it blows up by inserting a line:

If Trim(.Value) = "" Then
'do nothing
Else
msgbox .value & vblf & .address '<---- add this
'rest of code here

I expected something like:

xxxxxxxxxxxxxxxxx ###%
or
xxxxxxxxxxxxx ##%

And tried to pick off just the number (### or ##) portion.

 

[Himszy]

I know soon I'm gonna get annoying, if I'm not already

Dave all that happens is it lists the numbers 100 down to 1 in the first
column.

Is that all the code does?

 

[Dave Peterson]

Er, I hope not!

I put this in B14
-------B--------- --------C-------- --------D--------
Percentage11 98% Percentage21 95% Percentage31 94%
Percentage12 97% Percentage22 91% Percentage32 93%
Percentage13 92% Percentage23 95% Percentage33 97%
Percentage14 97% Percentage24 97% Percentage34 92%

And I got this on the new worksheet:

100
99
98 Percentage11
97 Percentage12
Percentage14 Percentage24 Percentage33
96
95 Percentage21
Percentage23
94 Percentage31
93 Percentage32
92 Percentage13 Percentage34
91 Percentage22

I know soon I'm gonna get annoying, if I'm not already

Dave all that happens is it lists the numbers 100 down to 1 in the first
column.

Is that all the code does?

 

[Himszy]

I meant I annoying to you.

Now I understand. My percentages are in a separate column:-

-------B--------- C --------D-------- E --------F--------
Percentage11 98% Percentage21 95% Percentage31 94%
Percentage12 97% Percentage22 91% Percentage32 93%
Percentage13 92% Percentage23 95% Percentage33 97%
Percentage14 97% Percentage24 97% Percentage34 92%

 

[Himszy]

Sorry I meant

also the percentages will change and there are 25 of them not 4 as i said
before if that matters

I meant I annoying to you.

Now I understand. My percentages are in a separate column:-

-------B--------- C --------D-------- E --------F------ G
Percentage11 98% Percentage21 95% Percentage31 94%
Percentage12 97% Percentage22 91% Percentage32 93%
Percentage13 92% Percentage23 95% Percentage33 97%
Percentage14 97% Percentage24 97% Percentage34 92%

Er, I hope not!

I put this in B14
-------B--------- --------C-------- --------D--------
Percentage11 98% Percentage21 95% Percentage31 94%
Percentage12 97% Percentage22 91% Percentage32 93%
Percentage13 92% Percentage23 95% Percentage33 97%
Percentage14 97% Percentage24 97% Percentage34 92%

And I got this on the new worksheet:

100
99
98 Percentage11
97 Percentage12
Percentage14 Percentage24 Percentage33
96
95 Percentage21
Percentage23
94 Percentage31
93 Percentage32
92 Percentage13 Percentage34
91 Percentage22

(words

and

Percentage31

 

[Dave Peterson]

How about this version:

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iCol As Long
Dim myVal As Variant
Dim myStr As String

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With newWks
With .Range("a1:a100")
.Formula = "=101-row()"
.Value = .Value
End With
End With

With curWks
For iCol = 2 To 51 Step 2 ' 25 total
Set myRng = .Range(.Cells(1, iCol), _
.Cells(.Rows.Count, iCol).End(xlUp))
For Each myCell In myRng.Cells
With myCell
If Trim(.Value) = "" Then
'do nothing
Else
myVal = Int(.Offset(0, 1).Value * 100)
myStr = newWks.Cells(101 - myVal, iCol / 2 + 1).Value
If myStr = "" Then
'do nothing
Else
'add a vblf
myStr = myStr & vbLf
End If
myStr = myStr & .Value
newWks.Cells(101 - myVal, iCol / 2 + 1).Value = myStr
End If
End With
Next myCell
Next iCol
End With

With newWks.UsedRange
.Columns.ColumnWidth = 255
.Columns.AutoFit
.Rows.AutoFit
End With

End Sub

<<snipped>>