Macro to retrieve data and to return in tabular form

[Madzark]

Hello guys,

I would like to run a macro that allows me to group some data that is scattered into tabular form. In particular, the information to be retrieved is "anticipated" by a number label contained in the cell immediately to the left of the relevant data to be retrieved. In addition, these labels are contained in definied columns.

For example:

A	B	C	D	E
1	1.000
2	2.000
3	3.000
4	4.000		5	10.000

<tbody>
</tbody>

A	B
1	1.000
2	2.000
3	3.000
4	4.000
5	10.000

<tbody>
</tbody>

In this case, the macro should search all the value reported between the labels from 1 to 5 and return these values in a different sheet with the relevant labels.

This would really help me a lot because I have more than 500 labels (and as much information) that I should convert into the table format.

Many thanks!

 

[DanteAmor]

The data is always every 3 columns, that is, columns A, D, G, J, etc.

 

[salim hasan]

Try This Macro

Option Explicit


Sub One_table()
Dim i%
Dim t%: t = Sheets("sheet1").Cells(Rows.Count, 2).End(3).Row + 1
Sheets("Sheet2").Range("B1").CurrentRegion.ClearContents
 For i = 5 To t Step 5
 Sheets("Sheet2").Range("B" & i - 4).Resize(4).Value = _
 Sheets("Sheet1").Range("B" & i - 4).Resize(4).Value
 Sheets("Sheet2").Range("B" & i).Formula = _
 "=SUM(B" & i - 4 & ":B" & i - 1 & ")"
  Next
  With Sheets("Sheet2").Range("B1").CurrentRegion
  .Value = .Value
  End With
End Sub

 

[Madzark]

The data is always every 3 columns, that is, columns A, D, G, J, etc.

Not realy, but the values to be found are in defined columns.

Try This Macro

Option Explicit


Sub One_table()
Dim i%
Dim t%: t = Sheets("sheet1").Cells(Rows.Count, 2).End(3).Row + 1
Sheets("Sheet2").Range("B1").CurrentRegion.ClearContents
 For i = 5 To t Step 5
 Sheets("Sheet2").Range("B" & i - 4).Resize(4).Value = _
 Sheets("Sheet1").Range("B" & i - 4).Resize(4).Value
 Sheets("Sheet2").Range("B" & i).Formula = _
 "=SUM(B" & i - 4 & ":B" & i - 1 & ")"
  Next
  With Sheets("Sheet2").Range("B1").CurrentRegion
  .Value = .Value
  End With
End Sub

Hello Salim,

Thank you so much for your contribution.


Unfortunately, it seems that your script does not work, as the sheet is full of writings that seem to be intercepted by the script itsleft.

To take up yesterday's example, the result of the script is as follows

	B
	1.000
	2.000
	3.000
	6.000

<tbody>
</tbody>

Why doesn't the script bring me the numeric label in correspondence of column 1? Why is there the B label? And where did you get the value of 6,000 from?

Just in case. The values to be searched for are contained in a scattered order in several defined columns. In my opinion, the macro should search inside the sheet for the individual labels by means of a cycle: I search label 1 inside the sheet, once found it I would report the value immediately next to the label 1 in sheet 2. Then I search 2, once found it I'll report the value immediately next to the label 2 in sheet 2, and so on..

Is this possible?

 

[DanteAmor]

Not realy, but the values to be found are in defined columns.

Can you explain what those defined columns are?
Is there a pattern in those defined columns?

 

[Madzark]

Can you explain what those defined columns are?
Is there a pattern in those defined columns?

Hi Dante,

I've uploaded an excel sample. Here it is the link:

https://mega.nz/#!0clH0CqS!C9XAcb7Jbmdu8-RMbVqz-w8seM5liaRf7ndM-D9Kx6U

 

[DanteAmor]

Hi Dante,
I've uploaded an excel sample.

I search label 1 inside the sheet, once found it I would report the value immediately next to the label 1 in sheet 2.

Try this:

Sub retrieve_data()
  Dim sh2 As Worksheet, n As Long, f As Range
  Set sh2 = Sheets("Sheet2")
  sh2.Cells.ClearContents
  n = 1
  Do While True
    Set f = Sheets("Sheet1").Cells.Find(n, , xlValues, xlWhole)
    If Not f Is Nothing Then
      sh2.Cells(n, "A").Value = n
      sh2.Cells(n, "B").Value = f.Offset(, 1)
      n = n + 1
    Else
      Exit Do
    End If
  Loop
End Sub

 

[Madzark]

Try this:

Sub retrieve_data()
  Dim sh2 As Worksheet, n As Long, f As Range
  Set sh2 = Sheets("Sheet2")
  sh2.Cells.ClearContents
  n = 1
  Do While True
    Set f = Sheets("Sheet1").Cells.Find(n, , xlValues, xlWhole)
    If Not f Is Nothing Then
      sh2.Cells(n, "A").Value = n
      sh2.Cells(n, "B").Value = f.Offset(, 1)
      n = n + 1
    Else
      Exit Do
    End If
  Loop
End Sub

Hi Danteamor,

your script seems to be working. However, in some cases the macro catches the values of columns F, I and L, but does not go in the remaining columns P, S and U. How come where I have an additional 100 values to copy. Why?

 

[DanteAmor]

Hi Danteamor,

your script seems to be working. However, in some cases the macro catches the values of columns F, I and L, but does not go in the remaining columns P, S and U. How come where I have an additional 100 values to copy. Why?

The macro is counting 1 and searching, 2 and searching, 3 and searching ... if it does not find 3 then it stops.
If you have 4, but not 3, the macro no longer searches for 4.

Can you at least say in which initial column the data will start?
That is, in your example the initial column is E, it will always start in E. With that I could change the way to search, then the macro would search by columns, if 3 does not exist, it does not matter, the macro would continue with the next column.

 

[Madzark]

The macro is counting 1 and searching, 2 and searching, 3 and searching ... if it does not find 3 then it stops.
If you have 4, but not 3, the macro no longer searches for 4.

Can you at least say in which initial column the data will start?
That is, in your example the initial column is E, it will always start in E. With that I could change the way to search, then the macro would search by columns, if 3 does not exist, it does not matter, the macro would continue with the next column.

You are right. There is a jump from 107 to 111. I tried to make a new retrieve_data() macro starting with n=111, but it doesn't work. How can I solve this?