SHARE
TWEET

Untitled

a guest Sep 13th, 2019 107 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub FetchArticles()
  2.     MsgBox "You have to have selected the row with column headers"
  3.    
  4.     Dim dataWorksheet As Worksheet
  5.     Set dataWorksheet = GetDataWorksheet()
  6.    
  7.     Dim cell As Range
  8.     Dim articleNumber As Integer
  9.     articleNumber = 1
  10.     For Each cell In dataWorksheet.Rows(1).Cells
  11.         If StrComp(cell.Value, "Artikl") = 0 Then
  12.             LoadArticle cell, articleNumber
  13.             articleNumber = articleNumber + 1
  14.         End If
  15.     Next cell
  16.    
  17. End Sub
  18.  
  19. ' Retrieves worksheet name from the user and returns worksheet object with that name.
  20. Function GetDataWorksheet() As Worksheet
  21.     ' Get worksheet name from the user, where the data is located
  22.    Dim worksheetName As String
  23.     worksheetName = InputBox("Enter name of the worksheet", "Data")
  24.    
  25.     ' Check if worksheet name is empty, if it is, exit the script
  26.    If StrComp(worksheetName, "") = 0 Then
  27.         MsgBox "Operation cancelled"
  28.         Exit Function
  29.     End If
  30.    
  31.     ' Get the worksheet with the name that the user entered...
  32.    Set GetDataWorksheet = Worksheets(worksheetName)
  33. End Function
  34.  
  35. ' Loads shop numbers and their values to specified row in the to-be-filled worksheet
  36. ' articleCell points to cell with string "Artikl" at the top of the table in data worksheet
  37. ' articleNumber is the number of the currently found article (line number for the to-be-filled worksheet)
  38. Sub LoadArticle(articleCell As Range, articleNumber As Integer)
  39.     Dim articleID As String
  40.     Dim cellOnRight As Range
  41.     Set cellOnRight = articleCell.Offset(0, 1)
  42.     articleID = cellOnRight.Value
  43.     'Write it to appropriate line
  44.    Dim found As Range
  45.     Set found = Selection.Find(What:="Èíslo zboží")
  46.     found.Offset(1 + articleNumber, 0).Value = articleID
  47.    
  48.     ' Now we will start going through shop numbers and fill the appropriate values in
  49.    ' currCell points at the current cell in the data worksheet
  50.    Dim currCell As Range
  51.     Set currCell = articleCell.Offset(4, 0)
  52.    
  53.     ' And found will point at the cell with correct shop number in the to-fill-in worksheet
  54.    Do While StrComp(currCell.Value, "") <> 0
  55.         ' First, find cell with the same shop number as currCell
  56.        Set found = Selection.Find(What:=currCell.Value)
  57.        
  58.         Dim cellToFill As Range
  59.         ' Cell to fill points at the cell to be currently filled in the to-fill-in worksheet
  60.        Set cellToFill = found.Offset(1 + articleNumber, 0)
  61.         ' Fill the cell to fill with the value from the data-sheet
  62.        cellToFill.Value = currCell.Offset(0, 4).Value
  63.         ' Slide to the next cell (shop number) in this article
  64.        Set currCell = currCell.Offset(1, 0)
  65.     Loop
  66. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top