Vfrdtyky

I am having data (image below) and task is to find values <3, identify what date and hour is and paste dates, hours in another spreadsheet of that cells. Does any have ideas?

Option Explicit

> 

> Sub CopyPaste()

> 

> Dim LastRow As Long, LastCol As Long, Row As Long, Column As Long, x

> As Long Dim wb As Workbook Dim ws As Worksheet, ws2 As Worksheet Dim

> SearchRange As Range, Cell As Range

> 

> Set wb = ThisWorkbook Set ws = wb.Sheets("DataHorizontal") 'the sheet

> in which your data is Set ws2 = wb.Sheets("Overview") 'the sheet where

> you want your result

> 

> LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row LastCol = ws.Cells(1,

> Columns.Count).End(xlToLeft).Column

> 

> Set SearchRange = ws.Range(ws.Cells(2, 2), ws.Cells(LastRow, LastCol))

> 

> x = 27

> 

> For Each Cell In SearchRange

>     Row = Cell.Row

>     Column = Cell.Column

>     If Cell.Value < -3 Or Cell.Value > 3 Then

>         'Output is placed in 2 columns, A for date, B for time

>         ws2.Cells(x, 5).Value = ws.Cells(Row, 1).Value 'Copy-paste Date

>         ws2.Cells(x, 6).Value = ws.Cells(1, Column).Value 'Copy-Paste Time

>         x = x + 1

>     End If Next Cell

> 

> End Sub

Output with <-3 or >3
Dataset more left columns

You need a macro to do so.

Code example

    Option Explicit



Sub CopyPaste()



Dim LastRow As Long, LastCol As Long, Row As Long, Column As Long, x As Long

Dim wb As Workbook

Dim ws As Worksheet, ws2 As Worksheet

Dim SearchRange As Range, Cell As Range



Set wb = ThisWorkbook

Set ws = wb.Sheets("input") 'the sheet in which your data is

Set ws2 = wb.Sheets("Output") 'the sheet where you want your result



LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

LastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column



Set SearchRange = ws.Range(ws.Cells(2, 2), ws.Cells(LastRow, LastCol))



x = 2



For Each Cell In SearchRange

    Row = Cell.Row

    Column = Cell.Column

    If Cell.Value < 3 Then

        'Output is placed in 2 columns, A for time, B for date

        ws2.Cells(x, 1).Value = ws.Cells(1, Column).Value 'Copy-Paste Time

        ws2.Cells(x, 2).Value = ws.Cells(Row, 1).Value 'Copy-paste Date

        x = x + 1

    End If

Next Cell



End Sub

Open the excel, press ALT+F11 and on the left side window, right click on the Worksheet you use (The name of the Worksheet can be found there), select Add -> Modul, and copy the following code into.

When you adjusted the variables, just press the Play button, or press F5.

Here is your solution:

Sub Stackoverflow()



Dim wbk1 As Workbook

Dim wbk2 As Workbook



Rem Creating a new workbook to collect data

Set wbk1 = ThisWorkbook

Set wbk2 = Workbooks.Add(xlWBATWorksheet)



Rem dc = datecolumn, the number of column AA

dc = Range("AA" & 1).Column



Rem k is the first row of new workbook, and i is the first row where the data can be found.

k = 1

i = 2



Do

  j = Range("AB" & 1).Column

  Do

    If wbk1.Worksheets("Work1").Cells(i, j).Value < 3 Then

      wbk2.Worksheets("Work1").Cells(k, 1) = wbk1.Worksheets("Work1").Cells(i, dc)

      wbk2.Worksheets("Work1").Cells(k, 2) = wbk1.Worksheets("Work1").Cells(1, j)

      wbk2.Worksheets("Work1").Cells(k, 3) = wbk1.Worksheets("Work1").Cells(i, j)

      k = k + 1

    End If

    j = j + 1

  Loop Until wbk1.Worksheets("Work1").Cells(i, j).Value = ""

  i = i + 1

Loop Until wbk1.Worksheets("Work1").Cells(i, j).Value = ""



Rem the result will be:

Rem first column in the new workbook will be the date

Rem second is the time

Rem third is the data



End Sub

Since you haven't provided the row numbers on your screen, you have to set the 'i' value to the first row where the data can be found. So if the row number is 2 where the number data are, just leave it so.

Please also note, you have to rename Work1 to the name of your Worksheet!

Hope this will help!

A faster way is using powerquery (Get & Transform Data).

Format your source data as a table, then use a query like this:

let

    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Date"}, "Time", "Value"),

    #"Filtered Rows" = Table.SelectRows(#"Unpivoted Other Columns", each [Value] < 3),

    #"Changed Type" = Table.TransformColumnTypes(#"Filtered Rows",{{"Date", type date}, {"Time", type time}, {"Value", type number}})

in

    #"Changed Type"

Result will be like this, where you can adjust output table:

Idea is to loop through every column for a date, and print values. Then go to next date (row) and repeat the procedure. Output will printed out as in the one from Column BA to BC.

Sub CompareCopy()

Dim ws1 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("Sheet1")

Dim ws2 As Worksheet

Set ws2 = ActiveWorkbook.Worksheets("Sheet1") 'You can change the output datas sheet.

Dim lrow As Long

Dim i As Long

Dim j As Long

Dim lCol As Long

Dim k As Long

Dim Header1 As String

Dim Header2 As String

Dim Header3 As String

Dim ColumnOutput As String



k = 2 'first row where output data will be placed



lCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'find last column

lrow = ws1.Cells(Rows.Count, 27).End(xlUp).Row 'Find last row



ColumnOutput = lCol 'Set Column where output should start, default is the last column of your original table.



ws2.Cells(k - 1, ColumnOutput + 2) = "Date" 'Place where "Date" will be printed

ws2.Cells(k - 1, ColumnOutput + 3) = "Time" 'Place where "Time" will be printed

ws2.Cells(k - 1, ColumnOutput + 4) = "Value" 'Place where "Value" will be printed



For i = 2 To lrow 'Loop through each row

    For j = 28 To lCol 'Loop through each Column

        If -3 > ws1.Cells(i, j).Value Then 'If current table value is less than -3 then copy

            ws2.Cells(k, ColumnOutput + 2).Value = ws1.Cells(i, 27).Value 'Copy Date

            ws2.Cells(k, ColumnOutput + 2).NumberFormat = "dd-mmm-yy" 'Format time value to correct time

            ws2.Cells(k, ColumnOutput + 3).Value = ws1.Cells(1, j).Value 'Copy Time

            ws2.Cells(k, ColumnOutput + 3).NumberFormat = "hh:mm" 'Format time value to correct time

            ws2.Cells(k, ColumnOutput + 4).Value = ws1.Cells(i, j).Value 'Copy Value

            k = k + 1

        End If

    Next j

Next i

End Sub