Find colums vba code needed

[gnusmas]

I need vba code!

Exemple i have the following columns and i want to extract columns just they get : 06, 15, 43

Sheet 1

01	01	03	02	01	04	04	01	03	04
03	06	04	06	02	05	05	05	05	06
06	08	06	08	06	06	06	06	06	07
07	14	09	11	10	11	08	08	10	08
12	16	12	12	12	14	11	10	13	12
13	17	13	13	17	17	14	13	15	19
15	20	16	16	18	20	17	14	16	22
18	24	18	20	21	21	20	15	18	25
19	30	20	21	22	22	21	20	20	27
28	32	22	23	25	23	23	22	21	28
29	37	25	28	29	25	25	29	29	31
31	39	26	31	30	27	27	30	32	33
32	41	29	33	31	29	29	31	33	34
33	42	31	34	37	30	30	35	35	36
34	43	32	35	38	31	31	36	39	43
35	44	38	36	39	35	33	37	41	44
43	47	42	37	43	40	40	38	42	46
46	49	43	40	44	43	43	43	43	47
47		46	43	45	44	46	47	44
49		47	47	46	47	47	49	47
		48		47	48	48
				48
				49

<tbody>
</tbody>

Sheet 2 output

01	01	03
03	05	05
06	06	06
07	08	10
12	10	13
13	13	15
15	14	16
18	15	18
19	20	20
28	22	21
29	29	29
31	30	32
32	31	33
33	35	35
34	36	39
35	37	41
43	38	42
46	43	43
47	47	44
49	49	47

<tbody>
</tbody>

Thank for help!

 

[hiker95]

gnusmas,

I have looked at your thread several times, and, I think I now understand what your actual raw data setup is?????

Sample worksheets:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	AP	AQ	AR	AS
1						01	01	03	02	01	04	04			01			03	04
2						03	06	04	06	02	05	05			05			05	06
3						06	08	06	08	06	06	06			06			06	07
4						07	14	09	11	10	11	08			08			10	08
5						12	16	12	12	12	14	11			10			13	12
6						13	17	13	13	17	17	14			13			15	19
7						15	20	16	16	18	20	17			14			16	22
8						18	24	18	20	21	21	20			15			18	25
9						19	30	20	21	22	22	21			20			20	27
10						28	32	22	23	25	23	23			22			21	28
11						29	37	25	28	29	25	25			29			29	31
12						31	39	26	31	30	27	27			30			32	33
13						32	41	29	33	31	29	29			31			33	34
14						33	42	31	34	37	30	30			35			35	36
15						34	43	32	35	38	31	31			36			39	43
16						35	44	38	36	39	35	33			37			41	44
17						43	47	42	37	43	40	40			38			42	46
18						46	49	43	40	44	43	43			43			43	47
19						47		46	43	45	44	46			47			44
20						49		47	47	46	47	47			49			47
21								48		47	48	48
22										48
23										49
24
Sheet1

Excel 2007
	A	B	C
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sheet2

After the macro in worksheet Sheet2:

Excel 2007
	A	B	C
1	01	01	03
2	03	05	05
3	06	06	06
4	07	08	10
5	12	10	13
6	13	13	15
7	15	14	16
8	18	15	18
9	19	20	20
10	28	22	21
11	29	29	29
12	31	30	32
13	32	31	33
14	33	35	35
15	34	36	39
16	35	37	41
17	43	38	42
18	46	43	43
19	47	47	44
20	49	49	47
21
22
23
24
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub GetColumns_F_O_AQ()
' hiker95, 09/27/2014, ME808154
Dim w1 As Worksheet, w2 As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.Columns("A:C").ClearContents
lr = w1.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
w1.Range("F1:F" & lr).Copy w2.Cells(1, "A")
w1.Range("O1:O" & lr).Copy w2.Cells(1, "B")
w1.Range("AQ1:AQ" & lr).Copy w2.Cells(1, "C")
Application.CutCopyMode = False
With w2
  .Columns("A:C").AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetColumns_F_O_AQ macro.

 

[Peter_SSs]

If hiker has the correct interpretation of the requirement, then possibly also this

Sub Get_Cols()
  Dim lr As Long
  
  lr = Sheets("Sheet1").Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
  Sheets("Sheet2").Columns("A:C").ClearContents
  Sheets("Sheet2").Range("A1").Resize(lr, 3).Value = Application.Index(Sheets("Sheet1").Columns("A:AQ"), Evaluate("row(1" & ":" & lr & ")"), Split("6 15 43"))
End Sub

 

[MickG]

Try:-

Dim Rng As Range
Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion
Sheets("Sheet2").Range("A1").Resize(Rng.Rows.Count, 3).Value = Application.Index(Rng, Evaluate("Row(1:" & Rng.Rows.Count & " )"), Array(1, 8, 9))

 

[gnusmas]

thank you for help but i need all columns that contains 06, 15, 43 not just allways 3 columns!!
exemple if sheet 1 contains 100 columns and just 35 columns contains 06, 15, 43 the Sheet 2 output 35 columns!!
Best rgds

 

[gnusmas]

hi, friend another exemple here loocking for columns just contains 13, 25, 31

Sheet 1

02	02	01	02	02	08	01	02	01	02	01	03	03	01	03	02	02	02	02	01	02	02
03	06	10	06	11	11	02	03	02	03	08	05	05	05	05	03	04	03	03	02	04	07
04	10	13	09	12	17	03	08	04	05	09	07	08	13	07	05	06	04	04	03	05	09
09	13	15	11	13	19	06	11	05	07	10	09	14	14	10	08	10	05	05	06	11	10
10	14	19	13	15	21	09	12	13	08	11	11	15	15	12	09	15	16	06	07	12	14
18	15	21	19	16	24	11	15	15	13	13	12	16	16	13	10	18	20	12	08	13	15
21	16	23	21	26	25	14	17	16	14	15	13	20	21	14	12	20	22	13	09	16	16
23	17	24	22	29	26	16	18	17	22	17	14	22	26	15	13	22	23	14	14	18	17
24	18	25	25	31	27	22	20	19	23	18	21	23	28	16	14	23	24	16	20	19	19
25	23	28	28	32	28	26	22	20	25	20	22	26	30	21	16	24	25	18	25	20	21
28	24	30	29	35	31	28	24	27	29	23	27	28	33	22	19	25	26	21	30	25	22
29	25	32	38	38	41	29	25	30	31	24	29	31	35	23	20	30	27	23	33	31	25
31	27	37	39	39	43	31	30	31	35	26	30	32	37	24	24	31	28	27	38	32	26
34	30	38	40	42	45	32	31	38	36	30	32	34	39	25	32	32	31	28	42	33	29
35	32	39	41	43	46	35	36	39	37	31	36	35	40	27	34	33	32	33	43	34	31
36	33	40	42	45	47	40	40	41	39	32	39	40	43	28	36	34	35	34	44	38	32
42	34	41	46	46	48	42	41	43	44	38	40	43	46	32	42	35	36	40	45	39	33
43	36	42	47	47	49	46	45	44	45	40	45	45	48	33	46	40	40	41	46	44	38
44	46	46	48	48		47	46	45	46	44	46	46	49	36		42	43	46	48	46	41
46	48	48				49	47	46		46	48			46		45	46	47	49	48	43
49							48			48						46	48	48			46
							49											49

<colgroup><col span="22"></colgroup><tbody>
</tbody>

Sheet 2 output

02	02
03	04
05	05
07	11
08	12
13	13
14	16
22	18
23	19
25	20
29	25
31	31
35	32
36	33
37	34
39	38
44	39
45	44
46	46
	48

<colgroup><col span="2"></colgroup><tbody>
</tbody>

result just 2 columns contains 13, 25, 31

thank you for help!

 

[hiker95]

gnusmas,

thank you for help but i need all columns that contains 06, 15, 43 not just allways 3 columns!!
exemple if sheet 1 contains 100 columns and just 35 columns contains 06, 15, 43 the Sheet 2 output 35 columns!!
Best rgds

This makes a BIG difference.

Are you always looking in worksheet Sheet1 just for 3 numbers in each column?

Are the numbers in Sheet1, numbers, or, text?

 

[Peter_SSs]

As it stands, this code assumes the values in Sheet1 are numerical, formatted to always show 2 digits, hence the leading zeros.
If Sheet1 contains text values then uncomment the two green lines of code and comment (or remove) the line immediately above each of those.

SSub GetCols()
  Dim a, b
  Dim i As Long, j As Long, k As Long, x As Long, y As Long, rws As Long
  
  Const LookFor As Long = 3 '<- No. of values per column to find. See 'Case' statement below
  
  a = Sheets("Sheet1").UsedRange.Value
  rws = UBound(a, 1)
  ReDim b(1 To rws, 1 To 1)
  For j = 1 To UBound(a, 2)
    k = 0
    For i = 1 To rws
      Select Case a(i, j)
        Case 13, 25, 31
'        Case "13", "25", "31"
          k = k + 1
      End Select
      If k = LookFor Then
        x = x + 1
        ReDim Preserve b(1 To rws, 1 To x)
        For y = 1 To rws
        b(y, x) = a(y, j)
        Next y
        Exit For
      End If
    Next i
  Next j
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("A1").Resize(rws, x).NumberFormat = "00"
'    .Range("A1").Resize(rws, x).NumberFormat = "@"
    .Range("A1").Resize(rws, x).Value = b
  End With
End Sub

 

[hiker95]

gnusmas,

The following macro will ask for three, 2 digit text numbers, with a single space character between the three text numbers.

For the below example, I entered:
13 25 31


Sample raw data in worksheet Sheet1:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	02	02	01	02	02	08	01	02	01	02	01	03	03	01	03	02	02	02	02	01	02	02
2	03	06	10	06	11	11	02	03	02	03	08	05	05	05	05	03	04	03	03	02	04	07
3	04	10	13	09	12	17	03	08	04	05	09	07	08	13	07	05	06	04	04	03	05	09
4	09	13	15	11	13	19	06	11	05	07	10	09	14	14	10	08	10	05	05	06	11	10
5	10	14	19	13	15	21	09	12	13	08	11	11	15	15	12	09	15	16	06	07	12	14
6	18	15	21	19	16	24	11	15	15	13	13	12	16	16	13	10	18	20	12	08	13	15
7	21	16	23	21	26	25	14	17	16	14	15	13	20	21	14	12	20	22	13	09	16	16
8	23	17	24	22	29	26	16	18	17	22	17	14	22	26	15	13	22	23	14	14	18	17
9	24	18	25	25	31	27	22	20	19	23	18	21	23	28	16	14	23	24	16	20	19	19
10	25	23	28	28	32	28	26	22	20	25	20	22	26	30	21	16	24	25	18	25	20	21
11	28	24	30	29	35	31	28	24	27	29	23	27	28	33	22	19	25	26	21	30	25	22
12	29	25	32	38	38	41	29	25	30	31	24	29	31	35	23	20	30	27	23	33	31	25
13	31	27	37	39	39	43	31	30	31	35	26	30	32	37	24	24	31	28	27	38	32	26
14	34	30	38	40	42	45	32	31	38	36	30	32	34	39	25	32	32	31	28	42	33	29
15	35	32	39	41	43	46	35	36	39	37	31	36	35	40	27	34	33	32	33	43	34	31
16	36	33	40	42	45	47	40	40	41	39	32	39	40	43	28	36	34	35	34	44	38	32
17	42	34	41	46	46	48	42	41	43	44	38	40	43	46	32	42	35	36	40	45	39	33
18	43	36	42	47	47	49	46	45	44	45	40	45	45	48	33	46	40	40	41	46	44	38
19	44	46	46	48	48		47	46	45	46	44	46	46	49	36		42	43	46	48	46	41
20	46	48	48				49	47	46		46	48			46		45	46	47	49	48	43
21	49							48			48						46	48	48			46
22								49											49
23
Sheet1

After the macro in worksheet Sheet2:

Excel 2007
	A	B	C
1	02	02
2	03	04
3	05	05
4	07	11
5	08	12
6	13	13
7	14	16
8	22	18
9	23	19
10	25	20
11	29	25
12	31	31
13	35	32
14	36	33
15	37	34
16	39	38
17	44	39
18	45	44
19	46	46
20		48
21
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub GetColumnsV2()
' hiker95, 09/29/2014, ME808154
Dim w1 As Worksheet, w2 As Worksheet
Dim lr As Long, lc As Long, nc As Long, c As Long
Dim n1 As String, n2 As String, n3 As String, tns As String
Dim s, i As Long, nlr As Long
Dim n1r As Range, n2r As Range, n3r As Range
tns = InputBox("Enter the 3, 2 digit, text numbers " & vbLf & " separated by a single space character.")
If Len(tns) <> 8 Then
  MsgBox "You have entered the incorrect string '" & tns & "' - macro terminated!"
  Exit Sub
End If
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.UsedRange.ClearContents
s = Split(tns, " ")
n1 = s(0): n2 = s(1): n3 = s(2)
With w1
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  For c = 1 To lc
    Set n1r = .Columns(c).Find(n1, LookAt:=xlWhole)
    Set n2r = .Columns(c).Find(n2, LookAt:=xlWhole)
    Set n3r = .Columns(c).Find(n3, LookAt:=xlWhole)
    If (Not n1r Is Nothing) * (Not n2r Is Nothing) * (Not n3r Is Nothing) Then
      nc = nc + 1
      nlr = .Cells(Rows.Count, c).End(xlUp).Row
      w1.Range(w1.Cells(1, c), w1.Cells(nlr, c)).Copy Destination:=w2.Range(w2.Cells(1, nc), w2.Cells(nlr, nc))
      Application.CutCopyMode = False
    End If
    Set n1r = Nothing
    Set n2r = Nothing
    Set n3r = Nothing
  Next c
End With
With w2
  .Columns(1).Resize(, nc).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetColumnsV2 macro.

 

[Peter_SSs]

gnusmas, it would be really useful to know if your values are numbers or text so we know, for example, if "02" is the actual number two formatted to show a leading zero or if it is a text string.