Odtnhj

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