Re: Search and Replace text
I would be happy to take on this development. What is your time frame for completion? Have you paid 10% to Ozgrid? Can you also supply a sample workbook please.
Re: Search and Replace text
I would be happy to take on this development. What is your time frame for completion? Have you paid 10% to Ozgrid? Can you also supply a sample workbook please.
Re: Return Currently Displayed Outline Level
If you just want to group and ungroup
Sub test()
Dim myRng As Range
Set myRng = Range("A1:K1")
If myRng.EntireColumn.Hidden Then
myRng.EntireColumn.Hidden = False
Else
myRng.EntireColumn.Hidden = True
End If
End Sub
Display More
I have found OutlineLevel property always returns 2.
Re: I want to create labelling by using macro kindly help
An option would be
Option Explicit
Sub AddLabels()
Const LABELROWCOUNT = 9
Const LABELCOLUMNCOUNT = 6
Dim textToAdd As String, firstLetter As String
Dim startNo As Long
Dim k As Integer, j As Integer
textToAdd = InputBox(Prompt:="Enter the starting label e.g. A0001", _
Title:="ENTER THE STARTING LABEL")
firstLetter = Left$(textToAdd, 1)
startNo = CLng(Mid(textToAdd, 2, Len(textToAdd) - 1))
For k = 1 To LABELROWCOUNT
For j = 1 To LABELCOLUMNCOUNT
Cells(k * 2, j * 2) = Left(UCase(firstLetter) & String(Len(textToAdd) - Len(CStr(startNo)), "0"), _
Len(textToAdd) - Len(CStr(startNo))) & CStr(startNo)
startNo = startNo + 1
Next
Next
End Sub
Display More
See attached workbook for an example - if you want to generate every label on the sheet you will just need to change the Const values
Re: Weighted median
Excellent. Your welcome.
Re: copy/paste valid value between worksheet
As the layout for Sheet1 and Sheet2 are different you will need to copy in sections but it is straight forward. For example to copy Advertiser, Engine, Campaign from sheet1 to (my assumption is next available cell on Sheet2) you would reference the sheets and use a simple method to determine the range to copy
Option Explicit
Sub CopyData()
Dim ws As Worksheet, ws1 As Worksheet
Set ws = Sheets(1): Set ws1 = Sheets(2)
ws.Range("A2:C" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Copy
ws1.Range("B" & ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Display More
Notice the way to find the last cell in the row
In the paste - you need to find the last row and add 1 if you want to keep appending data to sheet2. This should give you enough information to do the rest yourself. If this is not what you require then please supply more information with some examples in the sample workbook.
Note: Consider redesign of the workbook so you can copy the entire block of data in one go rather than copying in sections.
Re: Best Chart / Graph Design for My Data
Do you have a reference for the article (not a Wiki, FB page or a blog) - preferably the Journal/Original Source of the publication. If this is a peer reviewed article generally there will be a description of the statistical methods used in the study. This would help clarify how best to represent the data (if it has not already been done - no point reinventing the wheel)
Re: Weighted median
This UDF should do what you require - it will calculate the weighted median of the average number of applicants per vacancy for a specific state - it will not take into account any zero values. Vacancies is the weighting factor.
The formula is =WeightedMedianAvg(StateRng,Vacancies_Range,Applicants_Range)
So select the State as a single cell (as a parameter it is a range) then select the range of Vacancies, then the range of applicants
e.g. =WeightedMedianAvg(A2,I2:I12,D2:D12) A2 contains the State, the second range is the vacancies and the third range is the applicants. I have done it this way as it means that you can have the State column, Applicant column and Vacancy column anywhere in the workbook - they do not have to be together. However the ranges of the Applicants and Vacancies need to start at the same row and end at the same row in the formula. All parameters are validated prior to carrying out calculation. If this check fails the formula will generate #Value.
I have attached a workbook as well with some dummy data.
Function WeightedMedianAvg(StateRng As Range, Vacancies_Range As Range, Applicants_Range As Range) As Double
'
' WeightedMedianAvg Macro
' Calculate the weighted median of the average of a set of two distinct data ranges
'
Dim testVacRng As Long, testAppRng As Long, vacColNo As Long, appColNo As Long
Dim medCount As Long
Dim k As Integer, j As Integer, x As Integer
Dim avgArr() As Variant, wghtArr() As Variant
'Validate parameters
'Check StateRng is only one cell and is populated
If StateRng.Count > 1 Or StateRng.Value = vbNullString Then
WeightedMedianAvg = CVErr(xlErrValue)
End If
'check Vacancies and Applicants ranges start/end at same row
testVacRng = Vacancies_Range.Count
testAppRng = Applicants_Range.Count
If (testVacRng <> testAppRng) Or _
(Vacancies_Range.Row <> Applicants_Range.Row) Then
WeightedMedianAvg = CVErr(xlErrRef)
End If
x = 0
'Get columns of ranges
vacColNo = Vacancies_Range.Column: appColNo = Applicants_Range.Column
For k = Vacancies_Range.Row To (Vacancies_Range.Row + testVacRng - 1)
If UCase(Trim(StateRng.Value)) = UCase(Trim(Cells(k, StateRng.Column))) Then
If Cells(k, vacColNo) > 0 And Cells(k, appColNo) > 0 Then
ReDim Preserve avgArr(x): ReDim Preserve wghtArr(x)
avgArr(x) = Cells(k, appColNo) / Cells(k, vacColNo)
wghtArr(x) = Cells(k, vacColNo)
x = x + 1
End If
End If
Next
'calculate the number of values for median
medCount = Application.WorksheetFunction.Sum(wghtArr)
'create array to hold all the values accounting for weighting
ReDim finalArr(medCount - 1)
x = 0
For k = LBound(avgArr) To UBound(avgArr)
For j = 1 To wghtArr(k)
finalArr(x) = avgArr(k)
x = x + 1
Next
Next
WeightedMedianAvg = Application.Median(finalArr)
End Function
Display More
Re: Weighted median
The way I was intending to write this now that this is clear would be
=WeightMedAvg(State,State Range, Vacancy Range, Applicant Range)
State would be a string representing the state and the 3 Ranges would be the 3 columns (State, No of Vacancies, No of Applicants) - that way the 3 columns do not have to be next to each other - as long as the data for State is in 1 column, Applicants in 1 column and Vacancies in 1 column then the formula could have 4 parameters giving you the greatest flexibility in your workbook design. Prefer not to hard code in columns as it reduces portability of the UDF. I am currently at work - will write when I get home - will not take long to do.
Re: Borders Outline using Macro don't line up
This is the Hire Help Forum. Are you looking to hire someone to solve this problem for you?
If so you must state how much you are willing to pay and 10% of this amount must be paid to Ozgrid. If you do not want to hire someone please advise
Re: INDIRECT Link with another worksheet cell value
I did neglect to mention that fact. Interesting reference NBVC
Re: Dynamic file path
For those who utilise the forum as a source of information and education would you like to share your solution? Sharing knowledge I like to think is a foundation principle of Ozgrid.
Re: INDIRECT Link with another worksheet cell value
I cannot test as network path but as indirect takes a string for local would be
=INDIRECT(CONCATENATE("[FGSummary_PossibleToRes_",C1,".xlsx]NResSoak!$J$1"))
So without testing try
=INDIRECT(CONCATENATE("\\192.168.9913\SSRS_DailySummaryReport\[FGSummary_PossibleToRes_",C1,".xlsx]NResSoak!$J$1"))
Re: Find unique column of data
I cannot think of a faster way - however to maybe just increase speed slightly (I assume you are using option 2) add an Exit For statement
Sub UnevenRows()
Dim testRng As Range
Dim testArr As Variant
Dim k As Long, tstResult As Long
Dim foundCol As Long
For k = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
Set testRng = Range(Cells(1, k), Cells(Cells(Rows.Count, k).End(xlUp).Row, k))
testArr = testRng
tstResult = UniqCount(testArr)
If tstResult = WorksheetFunction.CountA(testRng) Then
foundCol = k
Exit For
End If
Next
MsgBox foundCol
End Sub
Display More
At least that way it will stop once it has found the result and not test more columns once it has the result.
(Sorry Apo - credited wrong person for the scripting dictionary suggestion)
Re: Find unique column of data
You could use the following if there are no empty rows
Option Explicit
Sub TestColumns()
Dim uniqueCount As Long
Dim k As Long, result As Long
For k = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(1, k), Cells(Cells(Rows.Count, k).End(xlUp).Row, k)).Name = "testRng"
uniqueCount = Evaluate("Sum(1 / CountIf(testRng,testRng))")
If uniqueCount = Cells(Rows.Count, k).End(xlUp).Row Then
result = k
Exit For
End If
Next
MsgBox "Found unique column at column - " & CStr(result)
End Sub
Display More
Or as Apo suggested this would work if there are some rows with empty values (as long as the unique column does not have empty rows)
Sub UnevenRows()
Dim testRng As Range
Dim testArr As Variant
Dim k As Long, tstResult As Long
Dim foundCol As Long
For k = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
Set testRng = Range(Cells(1, k), Cells(Cells(Rows.Count, k).End(xlUp).Row, k))
testArr = testRng
tstResult = UniqCount(testArr)
If tstResult = Cells(Rows.Count, k).End(xlUp).Row Then
foundCol = k
End If
Next
MsgBox foundCol
End Sub
Function UniqCount(tstArr As Variant) As Integer
Dim dic As Object
Dim v As Variant
Dim i As Long, result As Long
Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(tstArr) To UBound(tstArr)
dic(tstArr(i, 1)) = 1
Next i
For Each v In dic.Keys()
result = result + 1
Next v
UniqCount = result
End Function
Display More
Try attached workbook
Re: Find unique column of data
So does only ONE column contain ONLY unique values? All other columns have at least one duplicate value in column? Is that correct?
Re: Weighted median
A UDF will do this - just so I am clear your original post says
Quoteweighted median for the average number of applicants per vacancy by state
Does that mean you want the weighted median of the average for EACH state - so in effect there will be a result for each state. In you last post for example - that would be the calculation for ONE state?
Or have State as a parameter in the UDF along with the range containing the data
eg = WeightMedAvg(state,range)
Re: Weighted median
Do you actually mean weighted median (for those only with applicants and vacancies) or really do mean weighted median of the averages? If the latter is the case what do you use as the weighting for the averages? Based on your answers is a VBA solution acceptable?
Re: Creating a Bill of material generation
I am really trying to help you but I am really struggling to understand. Could you perhaps show an example sample input and and example sample output. I understand you need the results to a different sheet but I still do not know what the inputs will be. Show me a sample input on a sheet and show me how the output should appear. Show me step by step what the user will use as inputs (I assume a drop down box for each input?) - As I say I am happy to help but you need to explain in details with examples and I will try to work something out for you.
Re: Edit VBA code for saving data with merged cell
I am not sure exactly about which duplicate values you want to remove - you had selected all of them however I changed it to what I think you were trying to do. You may have to adjust to your needs.
Try
Option Explicit
Sub CPV_To_GL()
Dim wsCPV As Worksheet
Dim wsGL As Worksheet
Dim lRow As Long
Dim INVDATA As Variant
Const INVDATASTARTS = 14
Dim k As Long
Dim InvArr As Variant
Set wsCPV = Worksheets("CPV")
Set wsGL = Worksheets("GL")
lRow = wsGL.Cells(Rows.Count, "I").End(xlUp).Row + 1
wsCPV.Range("G6").Copy
wsGL.Range("A" & lRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wsCPV.Range("AB6").Copy
wsGL.Range("B" & lRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wsCPV.Range("AB8").Copy
wsGL.Range("C" & lRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wsCPV.Range("G10").Copy
wsGL.Range("D" & lRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wsCPV.Range("G12").Copy
wsGL.Range("E" & lRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
INVDATA = wsCPV.Range("A15").Resize(wsCPV.Cells(Rows.Count, "I").End(xlUp).Row - INVDATASTARTS, 28)
For k = LBound(INVDATA) To UBound(INVDATA)
InvArr = Array(INVDATA(k, 1), INVDATA(k, 5), INVDATA(k, 9), INVDATA(k, 20), INVDATA(k, 24), INVDATA(k, 28))
wsGL.Range("F" & lRow).Resize(, 6) = InvArr
lRow = lRow + 1
Next
wsGL.Range("F1").Resize(wsGL.Cells(Rows.Count, "F").End(xlUp).Row, 3).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End Sub
Display More