Sort Data in Specific way

[K]

Hi all, I have data in column A , D , E , F , G of my sheet (see below
the sample)

A D E F G -------- col
LC ZA 20 XA 30
XA LC 33 LC 22
ZA XA 44 ZA 19
YR TC 50 TC 88
TC ZZ 14

Data in column A is the key data and then same data is also in column
D and F and then there are values against coloumn D and F data in
column E and G. I want macro which should sort column D to G data
according to column A data in a way that if column A have value "LC"
then column D and F should also have same value "LC" in same row and
also there exact figures in column E and G. (see below the expected
result from macro)

A D E F G -------- col
LC LC 33 LC 22
XA XA 44 XA 30
ZA ZA 20 ZA 19
YR
TC TC 50 TC 88
ZZ 14 ---- This data gone to bottom as there
is not ZZ in column A

I hope I was able to explain my question. Can please any friend help
as this macro will be lots of time saving for me. Thanks in advance

 

[Joel]

I need a some questions answered.

1) Does any of the data in columns A, D, or F appear more than once in the
column?

2) Do you want column A sorted? does columns B and c also get sorted with A.

3) Are E and G formulas? Which column are they associated with. Can you
post these formulas?

4) Are D and F a formula? (=A1)

 

[K]

Hi joel nice to here from you. Please see below my answers to your
questions
1 - Data does not appear more than once in column A , D and F
2 - No I dont want column A to be sorted as Data in column A is
already correctly sorted. And i dont want any thing to happen in
column B and C as there is nothing in these columns
3 - Yes column E and G got formulas and they are not associated to any
column as the formulas are not like (=A1-B1) actualy they are like
(=1000-200)
4 - column D and F haven't got any formulas they just got simple value
like in column A (LC , XA etc....)

Thank for you help joel. i'll wait to hear from you

 

[Joel]

I copyied the data from sheet1 to sheet2

Sub SortColumns()

With Sheets("Sheet1")
'copy columns A - c from sheet 1 to sheet 2
.Columns("$A:$C").Copy _
Destination:=Sheets("Sheet2").Columns("$A")

LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

'Move column D,E and then column F,G
For ColCount = 4 To 6 Step 2
RowCount = 1
Do While .Cells(RowCount, ColCount) <> ""
Key = .Cells(RowCount, ColCount)
Data = .Cells(RowCount, ColCount).Offset(0, 1)

With Sheets("Sheet2")
'check if data is in column A
Set c = .Columns("A").Find( _
what:=Key, _
LookIn:=xlValues, _
lookat:=xlWhole)

If c Is Nothing Then
'If column F check if data is in column D
If ColCount = 6 Then
Set c = .Columns("D").Find( _
what:=Key, _
LookIn:=xlValues, _
lookat:=xlWhole)
If c Is Nothing Then
.Cells(NewRow, ColCount) = Key
.Cells(NewRow, ColCount + 1) = Data
NewRow = NewRow + 1
Else
.Cells(c.Row, ColCount) = Key
.Cells(c.Row, ColCount + 1) = Data
End If
Else
.Cells(NewRow, ColCount) = Key
.Cells(NewRow, ColCount + 1) = Data
NewRow = NewRow + 1
End If
Else
.Cells(c.Row, ColCount) = Key
.Cells(c.Row, ColCount + 1) = Data
End If
End With
RowCount = RowCount + 1
Loop
Next ColCount
End With

End Sub

 

[K]

Thanks lot Joel your code works perfectly fine. I just have two
questions that i got formulas like (=1000-200) etc in column E and G.
Is it possible that when macro copy data to Sheet 2 it should keep
formulas in these columns instead of just values. Like if i have
formula in Sheet 1 column E cell which is (=1000-200) so when macro
copy data to Sheet 2 it should keep this formula in column E as
(=1000-200) instead of putting value (800). I know you can only see
the result in cell but when you select that cell you can see its
formula aswell in above formula bar so thats why i need formulas to be
in cell. And second question is that i really liked the way you
solved my problem is it possilbe for you explain me bit more that how
your code is doing its work, just for my knowledge. Thanks again for
your help

 

[Joel]

I added some comments to code below and copied formula instead of value.

Sub SortColumns()

With Sheets("Sheet1")
'copy columns A - c from sheet 1 to sheet 2
.Columns("$A:$C").Copy _
Destination:=Sheets("Sheet2").Columns("$A")

'row.count is Last row on worksheet
'Search Up column A from Last Row until data is found
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

'Move column D,E and then column F,G
For ColCount = 4 To 6 Step 2
RowCount = 1
'Loop until no data is found in column D and F (Value of ColCount)
Do While .Cells(RowCount, ColCount) <> ""

'Get Data from Sheet1
Key = .Cells(RowCount, ColCount)
MyFormula = .Cells(RowCount, ColCount + 1).Formula

With Sheets("Sheet2")
'check if Key is in column A
Set c = .Columns("A").Find( _
what:=Key, _
LookIn:=xlValues, _
lookat:=xlWhole)

'check if Key is found. Will be nothing if not found
If c Is Nothing Then
'If column F check if data is in column D
If ColCount = 6 Then
'Look for Key in Column D
Set c = .Columns("D").Find( _
what:=Key, _
LookIn:=xlValues, _
lookat:=xlWhole)

'check if Key is found. Will be nothing if not found
If c Is Nothing Then
'Write Key and fomula to sheet 2 (Col D,E or F,G) in
New row
.Cells(NewRow, ColCount) = Key
.Cells(NewRow, ColCount + 1).Formula = MyFormula
'Increment Row to put data on Sheet2
NewRow = NewRow + 1
Else
'Write Key and fomula to sheet 2 (Col D,E or F,G)
'Write data to row where key was found in FIND function
above
.Cells(c.Row, ColCount) = Key
.Cells(c.Row, ColCount + 1).Formual = MyFormula
End If
Else
'Write Key and fomula to sheet 2 (Col D,E or F,G) in New row
.Cells(NewRow, ColCount) = Key
.Cells(NewRow, ColCount + 1).Formula = MyFormula
NewRow = NewRow + 1
End If
Else
'Key was found in Column A
'Write Key and fomula to sheet 2 (Col D,E or F,G)
'Write data to row where key was found in FIND function above
.Cells(c.Row, ColCount) = Key
.Cells(c.Row, ColCount + 1).Formula = MyFormula
End If
End With
RowCount = RowCount + 1
Loop
Next ColCount
End With

End Sub

 

[K]

I added some comments to code below and copied formula instead of value.

Sub SortColumns()

With Sheets("Sheet1")
   'copy columns A - c from sheet 1 to sheet 2
   .Columns("$A:$C").Copy _
      Destination:=Sheets("Sheet2").Columns("$A")

   'row.count is Last row on worksheet
   'Search Up column A from Last Row until data is found
   LastRow = .Range("A" & Rows.Count).End(xlUp).Row
   NewRow = LastRow + 1

   'Move column D,E and then column F,G
   For ColCount = 4 To 6 Step 2
      RowCount = 1
      'Loop until no data is found in column D and F (Value of ColCount)
      Do While .Cells(RowCount, ColCount) <> ""

         'Get Data from Sheet1
         Key = .Cells(RowCount, ColCount)
         MyFormula = .Cells(RowCount, ColCount + 1).Formula

         With Sheets("Sheet2")
            'check if Key is in column A
            Set c = .Columns("A").Find( _
               what:=Key, _
               LookIn:=xlValues, _
               lookat:=xlWhole)

            'check if Key is found.  Will be nothing if notfound
            If c Is Nothing Then
               'If column F check if data is in column D
               If ColCount = 6 Then
                  'Look for Key in Column D
                  Set c = .Columns("D").Find( _
                     what:=Key, _
                     LookIn:=xlValues, _
                     lookat:=xlWhole)

                  'check if Key is found.  Will be nothing if not found
                  If c Is Nothing Then
                     'Write Key and fomula to sheet2 (Col D,E or F,G) in
New row
                     .Cells(NewRow, ColCount) = Key
                     .Cells(NewRow, ColCount + 1).Formula = MyFormula
                     'Increment Row to put data on Sheet2
                     NewRow = NewRow + 1
                  Else
                     'Write Key and fomula to sheet2 (Col D,E or F,G)
                     'Write data to row where key was found in FIND function
above
                     .Cells(c.Row, ColCount) = Key
                     .Cells(c.Row, ColCount + 1).Formual = MyFormula
                  End If
               Else
                  'Write Key and fomula to sheet 2 (ColD,E or F,G) in New row
                  .Cells(NewRow, ColCount) = Key
                  .Cells(NewRow, ColCount + 1).Formula = MyFormula
                  NewRow = NewRow + 1
               End If
            Else
               'Key was found in Column A
               'Write Key and fomula to sheet 2 (Col D,E or F,G)
               'Write data to row where key was found in FIND function above
               .Cells(c.Row, ColCount) = Key
               .Cells(c.Row, ColCount + 1).Formula = MyFormula
            End If
         End With
         RowCount = RowCount + 1
      Loop
   Next ColCount
End With

End Sub





- Show quoted text -

Thanks lot joel