Move data from a row to column

H

harky

Active Member
Joined
Apr 8, 2010
Messages
405
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
Hi, i need some help. But not sure if someone able to help me.
I using excel 2010.

My Excel had total of 19 fix column.

Col_C is a series number while Col_S is a ''any number"
Possible to shift up (row to column) base on Col_S and delete repeated series no. on Col_C? while the rest col will be fill up with other information which is similar to Col_C


Col_ACol_BCol_CCol_DCol_ECol_FCol_GCol_HCol_ICol_JCol_KCol_LCol_MCol_NCol_OCol_PCol_QCol_RCol_S
Series 112
Series 120
Series 11
Series 135
Series 140
Series 223
Series 25
Series 264
Series 21A
Series 22B

<tbody>
</tbody>
 
Last edited:
Sort by date Sort by votes
Sort row but excluded the headEr which is row1
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Hi This is how i usually sort on excel.

Highlight the row, and sort Col D & Col R
Sort row but excluded the header which is row1

2vcf874.jpg


MickG said:
Does that mean you don't need the columns in between (D & R) to be sorted???
Click to expand...
 
Last edited:
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG06Apr25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant
        [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
          [COLOR="Navy"]With[/COLOR] Rng.Offset(, -3).Resize(, 18)
            .Sort Key1:=.Range("D1"), Key2:=.Range("R1"), Header:=xlYes
          [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Array(1, Nothing, Dn.Offset(, 14))
        [COLOR="Navy"]Else[/COLOR]
           Q = .Item(Dn.Value)
            Q(0) = Q(0) + 1
            
            [COLOR="Navy"]If[/COLOR] Q(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn.Offset(, 14)
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 14))
             [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
          .Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   [COLOR="Navy"]If[/COLOR] Not .Item(K)(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        .Item(K)(1).Copy
        [COLOR="Navy"]If[/COLOR] .Item(K)(0) > 1 [COLOR="Navy"]Then[/COLOR]
           .Item(K)(2).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
   
    [COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick! tested. It work! appreciated your help!
Going to put this on big data to test it. :)

MickG said:
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG06Apr25
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, K [COLOR=Navy]As[/COLOR] Variant, Q [COLOR=Navy]As[/COLOR] Variant
        [COLOR=Navy]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
          [COLOR=Navy]With[/COLOR] Rng.Offset(, -3).Resize(, 18)
            .Sort Key1:=.Range("D1"), Key2:=.Range("R1"), Header:=xlYes
          [COLOR=Navy]End[/COLOR] With
            [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
        [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            .Add Dn.Value, Array(1, Nothing, Dn.Offset(, 14))
        [COLOR=Navy]Else[/COLOR]
           Q = .Item(Dn.Value)
            Q(0) = Q(0) + 1
            
            [COLOR=Navy]If[/COLOR] Q(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Dn.Offset(, 14)
            [COLOR=Navy]Else[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 14))
             [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
          .Item(Dn.Value) = Q
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
   [COLOR=Navy]If[/COLOR] Not .Item(K)(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
        .Item(K)(1).Copy
        [COLOR=Navy]If[/COLOR] .Item(K)(0) > 1 [COLOR=Navy]Then[/COLOR]
           .Item(K)(2).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        [COLOR=Navy]End[/COLOR] If
  [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] K
   
    [COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
hi Mick,
I just tested the script with hug data. I notice D2 row was not sorted.

*edit: was able to fix it by change to D1

MickG said:
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG06Apr25
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, K [COLOR=Navy]As[/COLOR] Variant, Q [COLOR=Navy]As[/COLOR] Variant
        [COLOR=Navy]Set[/COLOR] Rng = Range(Range("[B][COLOR=#ff0000]D1[/COLOR][/B]"), Range("D" & Rows.Count).End(xlUp))
          [COLOR=Navy]With[/COLOR] Rng.Offset(, -3).Resize(, 18)
            .Sort Key1:=.Range("D1"), Key2:=.Range("R1"), Header:=xlYes
          [COLOR=Navy]End[/COLOR] With
            [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
        [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            .Add Dn.Value, Array(1, Nothing, Dn.Offset(, 14))
        [COLOR=Navy]Else[/COLOR]
           Q = .Item(Dn.Value)
            Q(0) = Q(0) + 1
            
            [COLOR=Navy]If[/COLOR] Q(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Dn.Offset(, 14)
            [COLOR=Navy]Else[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 14))
             [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
          .Item(Dn.Value) = Q
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
   [COLOR=Navy]If[/COLOR] Not .Item(K)(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
        .Item(K)(1).Copy
        [COLOR=Navy]If[/COLOR] .Item(K)(0) > 1 [COLOR=Navy]Then[/COLOR]
           .Item(K)(2).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        [COLOR=Navy]End[/COLOR] If
  [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] K
   
    [COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Last edited:
Upvote 0
Hi Mick,

Sorry! This script was OK but i missed something important!

can add in one more check for Col_Q? (As long Col Q is not "YES")

The marco will sort ColD thn ColR
After sort, it will base on Col_D series number thn Col_Q (if Col_Q has "YES", mean only delete repeat of Col_D the one with blank)
Col_Q only has Yes or empty = blank.

ColR is a ''any number" will be transposed (Shift up row to column)

xJMusiG.png


Result is like this.
Ptem1GG.png


MickG said:
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG06Apr25
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, K [COLOR=Navy]As[/COLOR] Variant, Q [COLOR=Navy]As[/COLOR] Variant
        [COLOR=Navy]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
          [COLOR=Navy]With[/COLOR] Rng.Offset(, -3).Resize(, 18)
            .Sort Key1:=.Range("D1"), Key2:=.Range("R1"), Header:=xlYes
          [COLOR=Navy]End[/COLOR] With
            [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
        [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            .Add Dn.Value, Array(1, Nothing, Dn.Offset(, 14))
        [COLOR=Navy]Else[/COLOR]
           Q = .Item(Dn.Value)
            Q(0) = Q(0) + 1
            
            [COLOR=Navy]If[/COLOR] Q(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Dn.Offset(, 14)
            [COLOR=Navy]Else[/COLOR]
                [COLOR=Navy]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 14))
             [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
          .Item(Dn.Value) = Q
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
   [COLOR=Navy]If[/COLOR] Not .Item(K)(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
        .Item(K)(1).Copy
        [COLOR=Navy]If[/COLOR] .Item(K)(0) > 1 [COLOR=Navy]Then[/COLOR]
           .Item(K)(2).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        [COLOR=Navy]End[/COLOR] If
  [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] K
   
    [COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
I'm not to sure what you are saying !!!!
Can you first confirm that the second image named "Result is like this" is the result you are trying to achieve.
That is to start each unique number list from the row with the Word "YES" in column "Q" then delete the blank rows.
The result you show , is the result you would get without sorting!!!
If the picture is not what you want to achieve please include example of results required..
 
Upvote 0
hi Mick, sorry.
Thanks for your sharp eye :)

The current script achieve what i want but add one more criteria. Which is ColQ, word in "YES" then delete the blank rows. thanks thanks
Sorry for the confuse.

This the Result trying to achieve (no changing in current script method, sorting remain.)
VUsAVxh.jpg


MickG said:
I'm not to sure what you are saying !!!!
Can you first confirm that the second image named "Result is like this" is the result you are trying to achieve.
That is to start each unique number list from the row with the Word "YES" in column "Q" then delete the blank rows.
The result you show , is the result you would get without sorting!!!
If the picture is not what you want to achieve please include example of results required..
Click to expand...
 
Last edited:
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Apr11
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant, Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
          [COLOR="Navy"]With[/COLOR] Rng.Offset(, -3).Resize(Rng.Count + 1, 18)
            .Sort Key1:=.Range("D1"), Key2:=.Range("R1"), Header:=xlYes
        [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Value, Array(1, Dn.Offset(, 14), Dn.Offset(, 14), Dn.Offset(, 14))
        [COLOR="Navy"]Else[/COLOR]
           Q = .Item(Dn.Value)
            Q(0) = Q(0) + 1
            [COLOR="Navy"]If[/COLOR] Dn.Offset(, 13) = "Yes" [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Q(3) = Dn.Offset(, 14)
                [COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 14))
          .Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
          [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, 13) = "Yes" [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   [COLOR="Navy"]If[/COLOR] Not .Item(K)(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        .Item(K)(1).Copy
        .Item(K)(3).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
     Temp = Range("R1").Value
        Columns("R:R").Delete
    Range("R1").Value = Temp
    [COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

tried this, but It delete everything except header .


MickG said:
Try this:-
Code: 
[COLOR=Navy]Sub[/COLOR] MG10Apr11
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, K [COLOR=Navy]As[/COLOR] Variant, Q [COLOR=Navy]As[/COLOR] Variant, Temp [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
        [COLOR=Navy]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
          [COLOR=Navy]With[/COLOR] Rng.Offset(, -3).Resize(Rng.Count + 1, 18)
            .Sort Key1:=.Range("D1"), Key2:=.Range("R1"), Header:=xlYes
        [COLOR=Navy]End[/COLOR] With
            [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
        [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            .Add Dn.Value, Array(1, Dn.Offset(, 14), Dn.Offset(, 14), Dn.Offset(, 14))
        [COLOR=Navy]Else[/COLOR]
           Q = .Item(Dn.Value)
            Q(0) = Q(0) + 1
            [COLOR=Navy]If[/COLOR] Dn.Offset(, 13) = "Yes" [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] Q(3) = Dn.Offset(, 14)
                [COLOR=Navy]Set[/COLOR] Q(1) = Union(Q(1), Dn.Offset(, 14))
          .Item(Dn.Value) = Q
        [COLOR=Navy]End[/COLOR] If
          [COLOR=Navy]If[/COLOR] Not Dn.Offset(, 13) = "Yes" [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
   [COLOR=Navy]If[/COLOR] Not .Item(K)(1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
        .Item(K)(1).Copy
        .Item(K)(3).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] K
     Temp = Range("R1").Value
        Columns("R:R").Delete
    Range("R1").Value = Temp
    [COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
VBA Sort Columns by Number in a Row on every Sheet in Workbook and Combine Data from all Sheets
Replies
6
Views
478
sijpie
sijpie
O
  • Question
Moving data from a single column to get more row values to work with
2
Replies
11
Views
510
Peter_SSs
Peter_SSs
D
  • Question
Create Header Row From Data & Place Column Data Across 4 Columns
Replies
0
Views
418
dts_1234
D
Fergus
  • Question
Code to transfer data from one workbook to another
Replies
5
Views
455
Fluff
Fluff
B
  • Question
Data Extraction from an Array
2
Replies
13
Views
1K
DanteAmor
DanteAmor

Forum statistics

Threads
1,214,636
Messages
6,120,668
Members
448,977
Latest member
moonlight6

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