Advertisement
Guest User

Untitled

a guest
Mar 9th, 2017
98
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub whatever()
  2.  
  3.     Dim i As Long, a As Long
  4.     Dim lngTopRowsToStartFrom As Long
  5.     Dim bolAbortOnEmptyLine As Boolean
  6.     lngTopRowsToStartFrom = 2
  7.    
  8.     Dim objSheet As Worksheet
  9.     Set objSheet = ActiveWorkbook.Sheets(1)
  10.    
  11.     Dim allCustomers() As tCustomRow 'String
  12.    Dim bolInit As Boolean
  13.    
  14.     bolAbortOnEmptyLine = True
  15.    
  16.     For i = lngTopRowsToStartFrom To Rows.Count
  17.        
  18.         If Trim(Range("B" & i).Value) <> "" Then
  19.            
  20.             If bolInit Then
  21.                 ReDim Preserve allCustomers(1 To UBound(allCustomers) + 1)
  22.             Else
  23.                 ReDim allCustomers(1 To 1)
  24.                 bolInit = True
  25.             End If
  26.            
  27.             'allCustomers(UBound(allCustomers)) = Range("B" & i).Value
  28.            allCustomers(UBound(allCustomers)).strCNumber = Range("A" & i).Value
  29.             allCustomers(UBound(allCustomers)).strCName = Range("B" & i).Value
  30.             allCustomers(UBound(allCustomers)).strINumber = Range("C" & i).Value
  31.             allCustomers(UBound(allCustomers)).strIPrice = Range("D" & i).Value
  32.        
  33.         Else
  34.        
  35.             If bolAbortOnEmptyLine Then Exit For
  36.        
  37.         End If
  38.    
  39.     Next i
  40.    
  41.     bolInit = False
  42.    
  43.     Dim uniqueCustomers() As String
  44.     Dim bolAlreadyAdded As Boolean
  45.    
  46.     For i = 1 To UBound(allCustomers)
  47.    
  48.         If Not bolInit Then
  49.            
  50.             ReDim uniqueCustomers(1 To 1)
  51.             uniqueCustomers(1) = allCustomers(1).strCName
  52.             bolInit = True
  53.                
  54.         Else
  55.        
  56.             bolAlreadyAdded = False
  57.              
  58.             For a = 1 To UBound(uniqueCustomers)
  59.            
  60.                 If uniqueCustomers(a) = allCustomers(i).strCName Then
  61.                     bolAlreadyAdded = True
  62.                     Exit For
  63.                 End If
  64.            
  65.             Next a
  66.            
  67.             If Not bolAlreadyAdded Then
  68.            
  69.                 ReDim Preserve uniqueCustomers(1 To UBound(uniqueCustomers) + 1)
  70.                 uniqueCustomers(UBound(uniqueCustomers)) = allCustomers(i).strCName
  71.            
  72.             End If
  73.        
  74.         End If
  75.            
  76.     Next i
  77.    
  78.     Dim objSheetToInsertAfter As Worksheet
  79.     Dim objNewInsertedSheet As Worksheet
  80.     Set objSheetToInsertAfter = objSheet
  81.            
  82.     Dim strSafeSheetName As String
  83.    
  84.     Dim n As Long
  85.     For i = 1 To UBound(uniqueCustomers)
  86.        
  87.         Set objNewInsertedSheet = ActiveWorkbook.Sheets.Add(, objSheetToInsertAfter)
  88.        
  89.         objNewInsertedSheet.Cells(1, 1) = "Customer Name"
  90.         objNewInsertedSheet.Cells(1, 2) = "Customer Number"
  91.         objNewInsertedSheet.Cells(1, 3) = "Item Number"
  92.         objNewInsertedSheet.Cells(1, 4) = "Item Price"
  93.        
  94.         n = 2
  95.         For a = 1 To UBound(allCustomers)
  96.             If allCustomers(a).strCName = uniqueCustomers(i) Then
  97.                                
  98.                 objNewInsertedSheet.Cells(n, 1) = allCustomers(a).strCName
  99.                 objNewInsertedSheet.Cells(n, 2) = allCustomers(a).strCNumber
  100.                
  101.                 objNewInsertedSheet.Cells(n, 3) = allCustomers(a).strINumber
  102.                 objNewInsertedSheet.Cells(n, 4) = allCustomers(a).strIPrice
  103.                
  104.                 n = n + 1
  105.             End If
  106.         Next a
  107.        
  108.         strSafeSheetName = Replace(uniqueCustomers(i), "/", "")
  109.         strSafeSheetName = Replace(strSafeSheetName, "*", "")
  110.        
  111.         objNewInsertedSheet.Name = strSafeSheetName
  112.        
  113.         Set objSheetToInsertAfter = objNewInsertedSheet
  114.    
  115.     Next i
  116.    
  117.     objSheet.Activate
  118.  
  119. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement