Help coding Excel Macro

N

namariegaudi

New Member
Joined
Oct 14, 2016
Messages
14
Hi. I'm not a programmer and need help for a local company I'm working with. I have a spreadsheet that has a fixed number of columns (number of rows changes), BUT the dates on those columns can vary. I need to transpose the data and copy the company for as many dates it has listed. There's a second caveat, there's a status columns that groups the data all in one field. I need to have the field separated (the assumption, is that each status answer belongs to a date (in chronological order to the dates listed). So in a nutshell I have:
<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Calibri; color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: center; font: 11.0px Calibri; color: #ffffff}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px 'Calibri Light'}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 11.0px 'Calibri Light'}p.p5 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px 'Calibri Light'; min-height: 13.0px}p.p6 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 11.0px 'Calibri Light'; min-height: 13.0px}table.t1 {border-collapse: collapse}td.td1 {background-color: #38d4d6; border-style: solid; border-width: 0.8px 1.0px 0.8px 0.8px; border-color: #a8d6ff #cbcbcb #a8d6ff #a8d6ff; padding: 0.0px 5.0px 0.0px 5.0px}td.td2 {background-color: #38d4d6; border-style: solid; border-width: 0.8px 1.0px 0.8px 1.0px; border-color: #a8d6ff #cbcbcb #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td3 {background-color: #d4feff; border-style: solid; border-width: 0.8px 1.0px 0.8px 0.8px; border-color: #a8d6ff #cbcbcb #a8d6ff #a8d6ff; padding: 0.0px 5.0px 0.0px 5.0px}td.td4 {background-color: #d4feff; border-style: solid; border-width: 0.8px 1.0px 0.8px 1.0px; border-color: #a8d6ff #cbcbcb #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td5 {border-style: solid; border-width: 0.8px 1.0px 0.8px 0.8px; border-color: #a8d6ff #cbcbcb #a8d6ff #a8d6ff; padding: 0.0px 5.0px 0.0px 5.0px}td.td6 {border-style: solid; border-width: 0.8px 1.0px 0.8px 1.0px; border-color: #a8d6ff #cbcbcb #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}</style>
Customer
Status
Fecha_Real_01
Fecha_Real_02
Fecha_Real_03
Fecha_Real_04
Fecha_Real_05
Fecha_Real_06
Fecha_Real_07
Fecha_Real_08
Fecha_Real_09
Fecha_Real_10
Fecha_Real_11
Fecha_Real_12
Fecha_Real_13
Fecha_Real_14
Fecha_Real_15
Serviacero Worthington
Si;#Si;#Si
5/1/18
9/1/18
14/3/18
























Aceros y Prensas
































STEEL TECHNOLOGIES DEMEXICO, S.A.






























De Acero
































ACEROS DEL TORO, SA DE CV
Si;#Si;#Si;#Si;#Si;#Si
9/1/18
23/1/18
1/3/18
9/3/18
14/3/18
22/3/18
13/4/18
















Coalición Acerera
































Proacero
































Aceros Galacticos

































<tbody>
</tbody>
And need something like this:
<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Calibri; color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px 'Calibri Light'}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 11.0px Calibri}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Calibri}p.p5 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 11.0px Calibri; min-height: 13.0px}table.t1 {border-collapse: collapse}td.td1 {background-color: #38d4d6; border-style: solid; border-width: 0.8px 1.0px 0.8px 0.8px; border-color: #a8d6ff #cbcbcb #a8d6ff #a8d6ff; padding: 0.0px 5.0px 0.0px 5.0px}td.td2 {background-color: #38d4d6; border-style: solid; border-width: 0.8px 1.0px 0.8px 1.0px; border-color: #a8d6ff #cbcbcb #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td3 {background-color: #38d4d6; border-style: solid; border-width: 0.8px 0.8px 0.8px 1.0px; border-color: #a8d6ff #a8d6ff #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td4 {background-color: #d4feff; border-style: solid; border-width: 0.8px 1.0px 0.8px 0.8px; border-color: #a8d6ff #cbcbcb #a8d6ff #a8d6ff; padding: 0.0px 5.0px 0.0px 5.0px}td.td5 {background-color: #d4feff; border-style: solid; border-width: 0.8px 1.0px 0.8px 1.0px; border-color: #a8d6ff #cbcbcb #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td6 {background-color: #d4feff; border-style: solid; border-width: 0.8px 0.8px 0.8px 1.0px; border-color: #a8d6ff #a8d6ff #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td7 {border-style: solid; border-width: 0.8px 1.0px 0.8px 0.8px; border-color: #a8d6ff #cbcbcb #a8d6ff #a8d6ff; padding: 0.0px 5.0px 0.0px 5.0px}td.td8 {border-style: solid; border-width: 0.8px 1.0px 0.8px 1.0px; border-color: #a8d6ff #cbcbcb #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}td.td9 {border-style: solid; border-width: 0.8px 0.8px 0.8px 1.0px; border-color: #a8d6ff #a8d6ff #a8d6ff #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}</style>
Customer
Date
Status
Serviacero Worthington
5/1/18
Si
Serviacero Worthington
9/1/18
Si
Serviacero Worthington
14/3/18
Si
Aceros y Prensas




STEEL TECHNOLOGIES DEMEXICO, S.A.


De Acero




ACEROS DEL TORO, SA DE CV
9/1/18
Si
ACEROS DEL TORO, SA DE CV
23/1/18
Si
ACEROS DEL TORO, SA DE CV
1/3/18
Si
ACEROS DEL TORO, SA DE CV
9/3/18
Si
ACEROS DEL TORO, SA DE CV
14/3/18
Si
ACEROS DEL TORO, SA DE CV
22/3/18
Si
ACEROS DEL TORO, SA DE CV
13/4/18



<tbody>
</tbody>
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
How about
Code: 
Sub Copytrans()

   Dim Qty As Long, Rws As Long
   Dim i As Long
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets.Add
   Dws.Name = "Output"
   
   Dws.Range("A1:C1").Value = Array("Customer", "Date", "Status")
   
   For i = 2 To Sws.Range("A" & Rows.count).End(xlUp).Row
      Qty = Application.CountA(Sws.Range("C" & i).Resize(, 15))
      If Qty = 0 Then Rws = 1 Else Rws = Qty
      With Dws.Range("A" & Rows.count).End(xlUp)
         .Offset(1).Resize(Rws).Value = Sws.Range("A" & i).Value
         .Offset(1, 1).Resize(Rws).Value = Application.Transpose(Sws.Range("C" & i).Resize(, 15).Value)
         If Qty > 0 Then
            .Offset(1, 2).Resize(Qty).Value = Application.Transpose(Split(Sws.Range("B" & i).Value, ";#"))
         End If
      End With
   Next i
   Dws.Range("C:C").SpecialCells(xlConstants, xlErrors).Clear
End Sub
 
Upvote 0
Thanks for your prompt response how would the code change if I have clientes on column A, dates are on columns AM-BA and status is on column P?
 
Upvote 0
namariegaudi said:
Thanks for your prompt response how would the code change if I have clientes on column A, dates are on columns AM-BA and status is on column P?
Click to expand...
You should not have simplified your question in your original post. You might keep the following in mind for any future questions you ask on this forum, or on any other forum for that matter.

A Generalized "Please Note"
--------------------------------------
For future questions you may ask, please do not simplify your question for us... doing so will get you a great answer to a question you do not actually have and which you do not actually care about AND it will almost always lead to you coming back for help when the solution we give you for the simplified question cannot be applied to your actual data and its layout. One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data, its layout and the overall objective for it).
 
Upvote 0
Try
Code: 
Sub Copytrans()

   Dim Qty As Long, Rws As Long
   Dim i As Long
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets.Add
   Dws.Name = "Output"
   
   Dws.Range("A1:C1").Value = Array("Customer", "Date", "Status")
   
   For i = 2 To Sws.Range("A" & Rows.count).End(xlUp).Row
      Qty = Application.CountA(Sws.Range("AM" & i).Resize(, 15))
      If Qty = 0 Then Rws = 1 Else Rws = Qty
      With Dws.Range("A" & Rows.count).End(xlUp)
         .Offset(1).Resize(Rws).Value = Sws.Range("A" & i).Value
         .Offset(1, 1).Resize(Rws).Value = Application.Transpose(Sws.Range("AM" & i).Resize(, 15).Value)
         If Qty > 0 Then
            .Offset(1, 2).Resize(Qty).Value = Application.Transpose(Split(Sws.Range("P" & i).Value, ";#"))
         End If
      End With
   Next i
   Dws.Range("C:C").SpecialCells(xlConstants, xlErrors).Clear
End Sub
 
Upvote 0
Wow, that was fast.
I get a runtime error 13 Type mismatch at the following line of code.
.Offset(1, 2).Resize(Qty).Value = Application.Transpose(Split(Sws.Range("P" & i).Value, ";#"))

I also noticed that the code goes only through 15 rows worth of data, as the list is much larger and will continue to grow, I assume the 15 would need to be changed to a dynamic value correct?
 
Upvote 0
What values do you have in the status column?
 
Upvote 0
options are: Si, No or Blank which Sharepoint (it's repetitive field) groups using ;# as separator between values. right now I have fields that have values such as:
No;#Si;#No
Si
Si;#Si;#Si
Si;#Si;#Si;#Si;#Si;#Si
Si;#Si;#Si;#Si;#Si;#Si;#Si;#Si;#Si;#Si;#No;#Si
 
Upvote 0
Ok, try
Code: 
Sub Copytrans()

   Dim Qty As Long, Rws As Long
   Dim i As Long
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets.Add
   Dws.Name = "Output"
   
   Dws.Range("A1:C1").Value = Array("Customer", "Date", "Status")
   
   For i = 2 To Sws.Range("A" & Rows.count).End(xlUp).Row
      Qty = Application.CountA(Sws.Range("AM" & i).Resize(, 15))
      If Qty = 0 Then Rws = 1 Else Rws = Qty
      With Dws.Range("A" & Rows.count).End(xlUp)
         .Offset(1).Resize(Rws).Value = Sws.Range("A" & i).Value
         .Offset(1, 1).Resize(Rws).Value = Application.Transpose(Sws.Range("AM" & i).Resize(, 15).Value)
         If Qty > 0 Then
            If InStr(1, Sws.Range("P" & i).Value, ";#") > 0 Then
               .Offset(1, 2).Resize(Qty).Value = Application.Transpose(Split(Sws.Range("P" & i).Value, ";#"))
            Else
               .Offset(1, 2).Value = Sws.Range("P" & i).Value
            End If
         End If
      End With
   Next i
   On Error Resume Next
   Dws.Range("C:C").SpecialCells(xlConstants, xlErrors).Clear
   On Error GoTo 0
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
hel separating
Replies
6
Views
645
Fluff
Fluff
J
  • Question
find dupes and hide non dupes
Replies
3
Views
597
Joe4
Joe4
B
  • Question
Appending a Value to Each Element of a Range Array
Replies
7
Views
2K
Peter_SSs
Peter_SSs
J
  • Question
help find not 'exact'
Replies
1
Views
605
mumps
mumps
N
  • Question
Help Macro Transpose Data
Replies
8
Views
623
namariegaudi
N

Forum statistics

Threads
1,215,066
Messages
6,122,948
Members
449,095
Latest member
nmaske

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