PDA

View Full Version : VBA to sort horizontal rows Help



weijianhk
06-21-2016, 08:29 AM
Hi Guys,

I need your help and expertise here. I'm trying to get my head around VBA to sort horizontal rows based on comparison of certain values under specific column headings.
Before the results are as shown in the URL image below.

ColumnA ColumnB ColumnC ColumnD ColumnE ColumnF ColumnG ColumnH
111 222 333 444 555 666 777 888

ColumnB and ColumnF have similar header name like "cost_default_smsc_1" and "cost_default_smsc_2". The cost will be compared and then display in ascending order.
Taking for example, ColumnF of 666 is cheaper than ColumnB of 222.
Column A, B,C,D belonged to a set of product, while E,F,G,H belong to another set. There are up to 10 products.

The resulting output in this case will be,

ColumnA ColumnB ColumnC ColumnD ColumnE ColumnF ColumnG ColumnH
555 666 777 888 111 222 333 444


Many thanks in advanc

mdmackillop
06-21-2016, 09:44 AM
Welcome to VBAX
You can post a sample workbook using Go Advanced/Manage Attachments

weijianhk
06-21-2016, 09:58 AM
Welcome to VBAX
You can post a sample workbook using Go Advanced/Manage Attachments

Thanks! I have put in the attachment.
Sheet1 shows the before behavior (raw data), and sheet2 should show the resulting output once the macro is applied.
So the comparison should be on the cost per se, which are the column headings that contain wordings "cost_default_smsc".
Thanks. 16440

mdmackillop
06-21-2016, 10:52 AM
Sub ColSort()
Dim Col As Range, Data
Set Col = Range("D2:D10")
For Each cel In Col
If cel > cel.Offset(, 5) Then
Data = cel.Offset(, -1).Resize(, 3).Value
cel.Offset(, -1).Resize(, 3).Value = cel.Offset(, 4).Resize(, 3).Value
cel.Offset(, 4).Resize(, 3).Value = Data
End If
Next
End Sub

weijianhk
06-21-2016, 08:00 PM
Sub ColSort()
Dim Col As Range, Data
Set Col = Range("D2:D10")
For Each cel In Col
If cel > cel.Offset(, 5) Then
Data = cel.Offset(, -1).Resize(, 3).Value
cel.Offset(, -1).Resize(, 3).Value = cel.Offset(, 4).Resize(, 3).Value
cel.Offset(, 4).Resize(, 3).Value = Data
End If
Next
End Sub


Thanks, this is awesome! However, i'm looking at comparing the cost of different SMSC, there are up to "default_smsc10_name".
Should there be some kind of array so that it will loop through to compare the cost?

Thanks again.

mdmackillop
06-22-2016, 12:28 AM
On rereading your posts, and looking at the requested example, I see no mention of 10 comparisons. Why would I code for such a case?

weijianhk
06-22-2016, 12:35 AM
I apologized if i misinterpret. In the test.xlsx example, there are 3 comparisons. I ran the above macro and can see that it compared the first 2 products but not 3.
Am i getting it wrongly?

Can you kindly help me here?

mdmackillop
06-22-2016, 11:13 AM
Option Explicit
Option Base 1
Sub Test()
Dim col As Long, rw As Long
Dim arr() As Variant
Dim i As Long, r As Long
Dim Vals() As Variant


col = (Cells(1, Columns.Count).End(xlToLeft).Column - 1) / 5
ReDim arr(col, 2)
ReDim Vals(col, 1 To 3)

rw = Cells(Rows.Count, 1).End(xlUp).Row
'Save variable data into array
For r = 2 To rw
For i = 1 To col
Vals(i, 1) = Cells(r, 5 * i - 2).Resize(, 3)
'Save sort values to array
arr(i, 1) = i
arr(i, 2) = Cells(r, (5 * i) - 1).Value
Next i
'Sort array
BubbleSort arr, 2
'write sorted values
For i = 1 To col
Cells(r, 5 * i - 2).Resize(, 3).Value = Vals(arr(i, 1), 1)
Next i
Next r
End Sub


Function BubbleSort(TempArray() As Variant, SortIndex As Long)
Dim blnNoSwaps As Boolean
Dim lngItem As Long
Dim vntTemp(1 To 2) As Variant
Dim lngCol As Long
Do
blnNoSwaps = True
For lngItem = LBound(TempArray) To UBound(TempArray) - 1
If TempArray(lngItem, SortIndex) > TempArray(lngItem + 1, SortIndex) Then
blnNoSwaps = False
For lngCol = 1 To 2
vntTemp(lngCol) = TempArray(lngItem, lngCol)
TempArray(lngItem, lngCol) = TempArray(lngItem + 1, lngCol)
TempArray(lngItem + 1, lngCol) = vntTemp(lngCol)
Next
End If
Next
Loop While Not blnNoSwaps
End Function