mardi 19 décembre 2017

Random row selection in multiple excel sheets

I have an output excel file from another macro which has multiple sheets (named 100,101,102... etc.) Sheet numbers will vary depending on prior macro's output.

Also there is a sheet named sheet1 which has info about how many random rows should be selected from 100,101,102... etc.

I tried to merge/combine what i could find from similar macros but i guess the loop part is way over my head.

I will run the macro from another "main" excel. which will open related output xls.

Then it will lookup for random rows amount from sheet1 and then select that number of random rows in related sheet and move to next sheet. (I'm getting the correct amount from lookup (used index match))

But for randomized part i was not able to make it work for multiple sheets.

It does not matter if it selects and colors the rows or copies and pastes them to another sheet/wb. Both is ok, but I need to automate this process since i have so much data waiting.

The macro i have managed so far is below, since I'm a newbie there may be unrelated or unnecessary things.

Is it possible?

Sub RANDOM()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Sh As Worksheet
Dim Durat As Long
StartTime = Now()
Dim mvn As Workbook
Dim FPath As String
Dim newWB As Workbook
Dim SheetN As Integer
Dim I As Long

FPath = ThisWorkbook.Path
Set mvn = Workbooks.Open(FileName:=ActiveWorkbook.Path & "\" & 
Sheets("Data").Range("C2").Value & " " & Sheets("Data").Range("C3").Value 
& " Muavinbol" & ".xls")

SheetN = mvn.Worksheets.Count
Set SampleS = mvn.Sheets("Sheet1")

For Each Sh In mvn.Worksheets
    Sh.Activate
    If Sh.Name <> "Sheet1" Then
        Dim lookupvalue As Integer
        Dim ranrows As Integer
        Dim randrows As Integer
     lookupvalue = Cells(1, 1).Value
     ranrows = Application.WorksheetFunction.Index(mvn.Sheets("Sheet1")_
.Range("S1:S304"), Application.WorksheetFunction.Match(lookupvalue, 
mvn.Sheets("Sheet1").Range("$D$1:$D$304"), 0))

'MsgBox lookupvalue & " " & ranrows
    End If

Next Sh

Durat = Round((Now() - StartTime) * 24 * 60 * 60, 0)

'MsgBox Durat & " seconds."

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub




Aucun commentaire:

Enregistrer un commentaire